Routine: PXRMP89I

PXRMP89I ; NA/AJB - Pre/Post Install ;Nov 06, 2024@12:59:08

 ;;2.0;CLINICAL REMINDERS;**89**;Feb 04, 2005;Build 16

 ; Reference to ^DIC in ICR #10006

 ; Reference to FIND1^DIC in ICR #2051

 ; Reference to UPDATE^DIE in ICR #2053

 ; Reference to WP^DIE in ICR#2053

 ; Reference to BMES^XPDUTL in ICR #10141

POST ;

 I '$$FIND1^DIC(811.4,"","","VA-PERSIAN GULF INDICATOR") D

 . D BMES^XPDUTL("Creating the Computed Finding...")

 . N DA,DIC,DLAYGO,PXRMDA,PXRMINST,TMP,X,Y

 . S TMP=DUZ(0),DUZ(0)="@"

 . S (DLAYGO,PXRMINST)=1,DIC="^PXRMD(811.4,",DIC(0)="ML",X="VA-PERSIAN GULF INDICATOR"

 . D ^DIC S DA=+Y Q:'DA

 . N ERROR,PXRMD

 . S PXRMD(811.4,DA_",",.02)="PXRMMSER"

 . S PXRMD(811.4,DA_",",.03)="PGULF"

 . S PXRMD(811.4,DA_",",.04)="VA-Persian Gulf Indicator"

 . S PXRMD(811.4,DA_",",5)="S"

 . S PXRMD(811.4,DA_",",100)="N"

 . D UPDATE^DIE("","PXRMD","PXRMDA","ERROR") Q:$D(ERROR)

 . N DESC S DESC(1,0)="This computed finding returns the PERSIAN GULF INDICATOR value."

 . D WP^DIE(811.4,DA_",",1,"","DESC","ERROR")

 . S DUZ(0)=TMP

 E  W !,"Entry already exists..."

 I '$$FIND1^DIC(801.41,"","","VA-GULFVET QUESTIONNAIRE") D

 . D BMES^XPDUTL("Creating Dialog...")

 . N DA,DIC,DLAYGO,PXRMDA,PXRMINST,TMP,X,Y

 . S (DLAYGO,PXRMINST)=1,DIC="^PXRMD(801.41,",DIC(0)="ML",X="VA-GULFVET QUESTIONNAIRE"

 . D ^DIC Q:'DA

 . N ERROR,PXRMD

 . S PXRMD(801.41,DA_",",4)="R"

 . D UPDATE^DIE("","PXRMD","PXRMDA","ERROR")

 . D LINK2TIU^PXRMDUTL("VA-GULFVET QUESTIONNAIRE","GULFVET QUESTIONNAIRE","",0,"TIU(8925.1,")

 E  D LINK2TIU^PXRMDUTL("VA-GULFVET QUESTIONNAIRE","GULFVET QUESTIONNAIRE","",0,"TIU(8925.1,")

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMP89I   1640     printed  Mar 13, 2025@20:52:59                                                                                                                                                                                                    Page 2

PXRMP89I  ; NA/AJB - Pre/Post Install ;Nov 06, 2024@12:59:08

 +1       ;;2.0;CLINICAL REMINDERS;**89**;Feb 04, 2005;Build 16

 +2       ;

 +3       ; Reference to ^DIC in ICR #10006

 +4       ; Reference to FIND1^DIC in ICR #2051

 +5       ; Reference to UPDATE^DIE in ICR #2053

 +6       ; Reference to WP^DIE in ICR#2053

 +7       ; Reference to BMES^XPDUTL in ICR #10141

 +8       ;

 +9        QUIT

POST      ;

 +1        IF '$$FIND1^DIC(811.4,"","","VA-PERSIAN GULF INDICATOR")

               Begin DoDot:1

 +2                DO BMES^XPDUTL("Creating the Computed Finding...")

 +3                NEW DA,DIC,DLAYGO,PXRMDA,PXRMINST,TMP,X,Y

 +4                SET TMP=DUZ(0)

                   SET DUZ(0)="@"

 +5                SET (DLAYGO,PXRMINST)=1

                   SET DIC="^PXRMD(811.4,"

                   SET DIC(0)="ML"

                   SET X="VA-PERSIAN GULF INDICATOR"

 +6                DO ^DIC

                   SET DA=+Y

                   if 'DA

                       QUIT

 +7                NEW ERROR,PXRMD

 +8                SET PXRMD(811.4,DA_",",.02)="PXRMMSER"

 +9                SET PXRMD(811.4,DA_",",.03)="PGULF"

 +10               SET PXRMD(811.4,DA_",",.04)="VA-Persian Gulf Indicator"

 +11               SET PXRMD(811.4,DA_",",5)="S"

 +12               SET PXRMD(811.4,DA_",",100)="N"

 +13               DO UPDATE^DIE("","PXRMD","PXRMDA","ERROR")

                   if $DATA(ERROR)

                       QUIT

 +14               NEW DESC

                   SET DESC(1,0)="This computed finding returns the PERSIAN GULF INDICATOR value."

 +15               DO WP^DIE(811.4,DA_",",1,"","DESC","ERROR")

 +16               SET DUZ(0)=TMP

               End DoDot:1

 +17      IF '$TEST

               WRITE !,"Entry already exists..."

 +18       IF '$$FIND1^DIC(801.41,"","","VA-GULFVET QUESTIONNAIRE")

               Begin DoDot:1

 +19               DO BMES^XPDUTL("Creating Dialog...")

 +20               NEW DA,DIC,DLAYGO,PXRMDA,PXRMINST,TMP,X,Y

 +21               SET (DLAYGO,PXRMINST)=1

                   SET DIC="^PXRMD(801.41,"

                   SET DIC(0)="ML"

                   SET X="VA-GULFVET QUESTIONNAIRE"

 +22               DO ^DIC

                   if 'DA

                       QUIT

 +23               NEW ERROR,PXRMD

 +24               SET PXRMD(801.41,DA_",",4)="R"

 +25               DO UPDATE^DIE("","PXRMD","PXRMDA","ERROR")

 +26               DO LINK2TIU^PXRMDUTL("VA-GULFVET QUESTIONNAIRE","GULFVET QUESTIONNAIRE","",0,"TIU(8925.1,")

               End DoDot:1

 +27      IF '$TEST

               DO LINK2TIU^PXRMDUTL("VA-GULFVET QUESTIONNAIRE","GULFVET QUESTIONNAIRE","",0,"TIU(8925.1,")

 +28       QUIT

PXRMP89I.m