| 1 | GMRAMCU0 ;HIRMFO/WAA-ID BAND/CHART MARKING UTILITIES ; 2/13/95 | 
|---|
| 2 | ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996 | 
|---|
| 3 | ; | 
|---|
| 4 | IDBAND(DFN,DATE,USR) ; This program will mark all the ID Band fields for | 
|---|
| 5 | ; all reactions for a patient | 
|---|
| 6 | ; | 
|---|
| 7 | ; INPUT | 
|---|
| 8 | ;         DFN = IEN for a patient in file 2 (Required) | 
|---|
| 9 | ;        DATE = Date of marking in File Manager format (optional- | 
|---|
| 10 | ;               if undefined or null current date/time will be used). | 
|---|
| 11 | ;         USR = User Marking the ID band (optional- if undefined null | 
|---|
| 12 | ;               will be used indicating data automatically entered). | 
|---|
| 13 | ; | 
|---|
| 14 | N GMRADT,GMRAPA,GMRAUSR | 
|---|
| 15 | S GMRADT=$G(DATE),GMRAUSR=$G(USR) | 
|---|
| 16 | I GMRADT="" S GMRADT=$$HTFM^XLFDT($H) | 
|---|
| 17 | S X=GMRADT,%DT="TS" D ^%DT S GMRADT=Y | 
|---|
| 18 | Q:$G(DFN)<1!(GMRADT<0)!(GMRAUSR'=""&(GMRAUSR'>0)) | 
|---|
| 19 | S GMRAPA=0 F  S GMRAPA=$O(^GMR(120.8,"B",DFN,GMRAPA)) Q:GMRAPA<1  D | 
|---|
| 20 | .Q:$P($G(^GMR(120.8,GMRAPA,0)),U,2)=""!+$G(^GMR(120.8,GMRAPA,"ER")) | 
|---|
| 21 | .N DA,DD,DO,DIC,DIE,DINUM,DR | 
|---|
| 22 | .S DIC="^GMR(120.8,"_GMRAPA_",14,",DIC(0)="L",DIC("P")="120.814DA",DLAYGO=120.8,DA(1)=GMRAPA,X=GMRADT D FILE^DICN K DA,DIC | 
|---|
| 23 | .I Y>0,GMRAUSR'="" D | 
|---|
| 24 | ..S DA(1)=GMRAPA,DA=+Y,DIE="^GMR(120.8,"_DA(1)_",14,",DR="1////"_GMRAUSR | 
|---|
| 25 | ..D ^DIE | 
|---|
| 26 | ..Q | 
|---|
| 27 | .Q | 
|---|
| 28 | Q | 
|---|