Routine: GMRCYP16

GMRCYP16 ;SLC/JFR - PRE/POST INSTALL FOR GMRC*3*16; 2/22/00 13:15

 ;;3.0;CONSULT/REQUEST TRACKING;**16**;DEC 27, 1997

ENV ;env check for service name conflict

 N GMRCSVC,I

 I $$PATCH^XPDUTL("GMRC*3.0*16") Q

 K ^TMP("GMRCYP16",$J)

 S GMRCSVC=0

 F  S GMRCSVC=$O(^GMR(123.5,GMRCSVC)) Q:'GMRCSVC  D

 . Q:'$D(^GMR(123.5,GMRCSVC,0))

 . D CHK1235($P(^GMR(123.5,GMRCSVC,0),U))

 I '$D(^TMP("GMRCYP16",$J)) D  Q

 . D BMES^XPDUTL("No conflicts with services being filed.")

 D WARNING(.GMRCMSG),MES^XPDUTL(.GMRCMSG)

 D BMES^XPDUTL(" ")

 S I=0 F  S I=$O(^TMP("GMRCYP16",$J,I)) Q:'I  D

 . D MES^XPDUTL(^TMP("GMRCYP16",$J,I,0))

 K ^TMP("GMRCYP16",$J)

CHK1235(SERVNM) ;check service name against exact or possible conflicts

 I SERVNM="CONTACT LENS REQUEST" D MSG(SERVNM,0) Q

 I SERVNM="HOME OXYGEN REQUEST" D MSG(SERVNM,0) Q

 I SERVNM="PROSTHETICS REQUEST" D MSG(SERVNM,0) Q

 I SERVNM="EYEGLASS REQUEST" D MSG(SERVNM,0) Q

 I SERVNM["LENS" D MSG(SERVNM,1) Q

 I SERVNM["OXYGEN" D MSG(SERVNM,1) Q

 I SERVNM["O2" D MSG(SERVNM,1) Q

 I SERVNM["PROSTHETICS" D MSG(SERVNM,1) Q

 I SERVNM["EYEGLASS"  D MSG(SERVNM,1) Q

MSG(TEXT,FLG) ;write install message if exact or partial match

 N MATCH,NEXT,MSG

 S MATCH=$S(+FLG:" partially ",1:" exactly ")

 S NEXT=$O(^TMP("GMRCYP16",$J,999),-1)+1

 S MSG=TEXT_MATCH_"matches one of the services being imported."

 S ^TMP("GMRCYP16",$J,NEXT,0)=MSG

WARNING(TXT) ;format warning statement for pre-install in case of conflicts

 S TXT(1)=$$FMTE^XLFDT($$NOW^XLFDT)

 S TXT(2)="This patch imports data for 4 services in the REQUEST SERVICES (#123.5) file."

 S TXT(3)="If the services do not exist in your file, they will be created as new"

 S TXT(4)="entries. If the services do exist on your system, certain fields of data will"

 S TXT(5)="be overwritten. The fields that will be overwritten are (#1.11) PRINT NAME,"

 S TXT(6)="(#1.01) PROVISIONAL DX PROMPT, (#1.02) PROVISIONAL DX INPUT, and "

 S TXT(7)="(#124) DEFAULT REASON FOR REQUEST. "

 S TXT(8)=" "

 S TXT(9)="Following this warning message, there will be one or more lines that "

 S TXT(10)="indicate that either an exact or partial match was found on your system."

 S TXT(11)="It is highly recommended that the install be aborted at this time until the"

 S TXT(12)="individual responsible for management of Consult/Request Tracking can "

 S TXT(13)="review and verify that these changes will not adversely affect operations"

 S TXT(14)="of the package."

POST ; load services into SUB-SERVICE SPECIALTY of ALL SERVICES

 N SVC

 S SVC=$$FIND1^DIC(123.5,,"QX","CONTACT LENS REQUEST") I +SVC D SUB(SVC)

 S SVC=$$FIND1^DIC(123.5,,"QX","HOME OXYGEN REQUEST") I +SVC D SUB(SVC)

 S SVC=$$FIND1^DIC(123.5,,"QX","EYEGLASS REQUEST") I +SVC D SUB(SVC)

 S SVC=$$FIND1^DIC(123.5,,"QX","PROSTHETICS REQUEST") I +SVC D SUB(SVC)

SUB(SVIEN) ; add as sub of ALL SERVICES

 I $D(^GMR(123.5,"APC",SVIEN)) Q

 N DIC,DA,X,Y

 S DA(1)=1

 S DIC="^GMR(123.5,"_DA(1)_",10,"

 S DIC(0)="XL"

 S X=$P(^GMR(123.5,SVIEN,0),U) Q:'$L(X)

 D ^DIC

GMRCYP16  ;SLC/JFR - PRE/POST INSTALL FOR GMRC*3*16; 2/22/00 13:15

 +1       ;;3.0;CONSULT/REQUEST TRACKING;**16**;DEC 27, 1997

ENV       ;env check for service name conflict

 +1        NEW GMRCSVC,I

 +2        IF $$PATCH^XPDUTL("GMRC*3.0*16")

               QUIT

 +3        KILL ^TMP("GMRCYP16",$JOB)

 +4        SET GMRCSVC=0

 +5        FOR

               SET GMRCSVC=$ORDER(^GMR(123.5,GMRCSVC))

               IF 'GMRCSVC

                   QUIT

               Begin DoDot:1

 +6                IF '$DATA(^GMR(123.5,GMRCSVC,0))

                       QUIT

 +7                DO CHK1235($PIECE(^GMR(123.5,GMRCSVC,0),U))

               End DoDot:1

 +8        IF '$DATA(^TMP("GMRCYP16",$JOB))

               Begin DoDot:1

 +9                DO BMES^XPDUTL("No conflicts with services being filed.")

               End DoDot:1

               QUIT

 +10       DO WARNING(.GMRCMSG)

           DO MES^XPDUTL(.GMRCMSG)

 +11       DO BMES^XPDUTL(" ")

 +12       SET I=0

FOR

               SET I=$ORDER(^TMP("GMRCYP16",$JOB,I))

               IF 'I

                   QUIT

               Begin DoDot:1

 +13               DO MES^XPDUTL(^TMP("GMRCYP16",$JOB,I,0))

               End DoDot:1

 +14       KILL ^TMP("GMRCYP16",$JOB)

 +15       QUIT

CHK1235(SERVNM) ;check service name against exact or possible conflicts

 +1        IF SERVNM="CONTACT LENS REQUEST"

               DO MSG(SERVNM,0)

               QUIT

 +2        IF SERVNM="HOME OXYGEN REQUEST"

               DO MSG(SERVNM,0)

               QUIT

 +3        IF SERVNM="PROSTHETICS REQUEST"

               DO MSG(SERVNM,0)

               QUIT

 +4        IF SERVNM="EYEGLASS REQUEST"

               DO MSG(SERVNM,0)

               QUIT

 +5        IF SERVNM["LENS"

               DO MSG(SERVNM,1)

               QUIT

 +6        IF SERVNM["OXYGEN"

               DO MSG(SERVNM,1)

               QUIT

 +7        IF SERVNM["O2"

               DO MSG(SERVNM,1)

               QUIT

 +8        IF SERVNM["PROSTHETICS"

               DO MSG(SERVNM,1)

               QUIT

 +9        IF SERVNM["EYEGLASS"

               DO MSG(SERVNM,1)

               QUIT

 +10       QUIT

MSG(TEXT,FLG) ;write install message if exact or partial match

 +1        NEW MATCH,NEXT,MSG

 +2        SET MATCH=$SELECT(+FLG:" partially ",1:" exactly ")

 +3        SET NEXT=$ORDER(^TMP("GMRCYP16",$JOB,999),-1)+1

 +4        SET MSG=TEXT_MATCH_"matches one of the services being imported."

 +5        SET ^TMP("GMRCYP16",$JOB,NEXT,0)=MSG

 +6        QUIT

WARNING(TXT) ;format warning statement for pre-install in case of conflicts

 +1        SET TXT(1)=$$FMTE^XLFDT($$NOW^XLFDT)

 +2        SET TXT(2)="This patch imports data for 4 services in the REQUEST SERVICES (#123.5) file."

 +3        SET TXT(3)="If the services do not exist in your file, they will be created as new"

 +4        SET TXT(4)="entries. If the services do exist on your system, certain fields of data will"

 +5        SET TXT(5)="be overwritten. The fields that will be overwritten are (#1.11) PRINT NAME,"

 +6        SET TXT(6)="(#1.01) PROVISIONAL DX PROMPT, (#1.02) PROVISIONAL DX INPUT, and "

 +7        SET TXT(7)="(#124) DEFAULT REASON FOR REQUEST. "

 +8        SET TXT(8)=" "

 +9        SET TXT(9)="Following this warning message, there will be one or more lines that "

 +10       SET TXT(10)="indicate that either an exact or partial match was found on your system."

 +11       SET TXT(11)="It is highly recommended that the install be aborted at this time until the"

 +12       SET TXT(12)="individual responsible for management of Consult/Request Tracking can "

 +13       SET TXT(13)="review and verify that these changes will not adversely affect operations"

 +14       SET TXT(14)="of the package."

 +15       QUIT

 +16      ;

 +17      ;

POST      ; load services into SUB-SERVICE SPECIALTY of ALL SERVICES

 +1        NEW SVC

 +2        SET SVC=$$FIND1^DIC(123.5,,"QX","CONTACT LENS REQUEST")

           IF +SVC

               DO SUB(SVC)

 +3        SET SVC=$$FIND1^DIC(123.5,,"QX","HOME OXYGEN REQUEST")

           IF +SVC

               DO SUB(SVC)

 +4        SET SVC=$$FIND1^DIC(123.5,,"QX","EYEGLASS REQUEST")

           IF +SVC

               DO SUB(SVC)

 +5        SET SVC=$$FIND1^DIC(123.5,,"QX","PROSTHETICS REQUEST")

           IF +SVC

               DO SUB(SVC)

 +6        QUIT

SUB(SVIEN) ; add as sub of ALL SERVICES

 +1        IF $DATA(^GMR(123.5,"APC",SVIEN))

               QUIT

 +2        NEW DIC,DA,X,Y

 +3        SET DA(1)=1

 +4        SET DIC="^GMR(123.5,"_DA(1)_",10,"

 +5        SET DIC(0)="XL"

 +6        SET X=$PIECE(^GMR(123.5,SVIEN,0),U)

           IF '$LENGTH(X)

               QUIT

 +7        DO ^DIC

 +8        QUIT

GMRCYP16.m