ORY148.m

ORY148 ;SLC/PKS -- postinit rtn for OR*3*148 ;6/21/02  12:04 [7/23/02 2:15pm]

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**148**;Dec 17, 1997

 ;

 Q

 ;

PRE ; -- preinit

 ;

 Q

 ;

POST ; -- postinit

 ;

 N VER,ORCOUNT

 ;

 S VER=$P($T(VERSION^ORY148),";",3)

 D USERSET

 D PAROUT

 I +$$PATCH^XPDUTL("TIU*1.0*109") D CPREG

 I +$$PATCH^XPDUTL("TIU*1.0*112") D SURGREG

 D MAIL

 ;

 Q

 ;

USERSET ; Queue background task to set user default settings.

 ;

 N ZTRTN,ZTDESC,ZTIO,ZTSAVE,ZTDTH,ZTSK

 ;

 S ZTRTN="DQSET^ORY148",ZTDESC="OR*3*148 Post Install",ZTIO="",ZTSAVE("DUZ")="",ZTDTH=$H

 D ^%ZTLOAD

 I $G(ZTSK) D MES^XPDUTL("User defaults for OR*3*148 queued as task number "_ZTSK_".")

 I '$G(ZTSK) D MES^XPDUTL("User defaults task did not queue")

 ;

 Q

 ;

DQSET ; Queue background task to set user default settings.

 ;

 S ORCOUNT=0

 S ^TMP("ORY148",$J,1)="Background task for OR*3*148 has completed."

 S ^TMP("ORY148",$J,2)=" "

 S ^TMP("ORY148",$J,3)="The following problems were encountered:"

 S ^TMP("ORY148",$J,4)=" "

 S ORCOUNT=4

 ;

 ; Set user default settings:

 D DEFTABS

 I ORCOUNT=4 S ^TMP("ORY148",$J,5)="No problems encountered."

 ;

 ; Send message with results to user, postmaster:

 N XMSUB,XMTEXT,SMDUZ,SMY

 S XMSUB="Patch OR*3*148 Post-Install Complete"  ; Message subject.

 S XMDUZ="Patch OR*3*148 Post Install"           ; Message "from."

 S XMY(.5)="" S:$G(DUZ) XMY(DUZ)=""              ; To user,postmaster.

 S XMTEXT="^TMP(""ORY148"",$J,"                  ; Text for message.

 D ^XMD

 K ^TMP("ORY148",$J)

 ;

 Q

 ;

DEFTABS ; Default tab, restricted patient list entries for GUI users.

 ;

 N ORZ,ORZZ,OROPT,ORUSER,DIE

 ;

 S OROPT="OR CPRS GUI CHART"

 S OROPT=$$OPTLK^XQCS(OROPT)

 S OROPT=+OROPT

 I OROPT<1  D  Q

 .W !,"No OR CPRS GUI CHART Option found!"

 ;

 ; Establish loop to order through users:

 S ORUSER=0

 F  S ORUSER=$O(^VA(200,ORUSER)) Q:'ORUSER>0  D

 .S ORZ=0

 .S ORZ=$$ACCESS^XQCHK(ORUSER,OROPT) ; Have OR CPRS GUI CHART option?

 .S ORZ=+ORZ

 .S ORZZ=$G(^VA(200,ORUSER,0))

 .S ORZZ=$P(ORZZ,U,4)

 .I ((ORZ>0)!(ORZZ["@"))  D

 ..;

 ..; Set default of "COR" for CPRS tabs multiple:

 ..N ORFDA,ORIEN,ORERR

 ..S ORIEN(1)=ORUSER

 ..S ORFDA(200.010113,"+2,"_ORUSER_",",.01)=1

 ..S ORFDA(200.010113,"+2,"_ORUSER_",",.02)=DT

 ..I ('$D(^VA(200,ORUSER,"ORD",0))) D UPDATE^DIE("","ORFDA","ORIEN","ORERR")

 ..I $D(ORERR)  D

 ...;

 ...; Send installation error message to run under Taskman:

 ...S ORCOUNT=ORCOUNT+1

 ...S ^TMP("ORY148",$J,ORCOUNT)="Could not create default COR Tab entry for user "_ORUSER_"."

 ..;

 ..; Set default of "N" for restricted patient list field:

 ..N ORFDA,ORIEN,ORERR

 ..S ORIEN(1)=ORUSER

 ..S ORFDA(200,ORUSER_",",101.01)=0

 ..I ('$D(^VA(200,ORUSER,101))) D UPDATE^DIE("","ORFDA","ORIEN","ORERR")

 ..I $D(ORERR)  D

 ...;

 ...; Send installation error message to run under Taskman:

 ...S ORCOUNT=ORCOUNT+1

 ...S ^TMP("ORY148",$J,ORCOUNT)="Could not make RPL default NO entry for user "_ORUSER_"."

 ..;

 ..D CLEAN^DILF ; Clean up after DB call.

 ;

 Q

 ;

CPREG ; Register TIU Clinical Procedures RPCs if TIU*1.0*109 present

 N MENU,RPC

 S MENU="OR CPRS GUI CHART"

 F RPC="TIU IS THIS A CLINPROC?","TIU IDENTIFY CLINPROC CLASS","TIU LONG LIST CLINPROC TITLES"  D INSERT(MENU,RPC)

 Q

 ;

SURGREG ; Register TIU SURGERY RPCs if TIU*1.0*112 present

 N MENU,RPC

 S MENU="OR CPRS GUI CHART"

 F RPC="TIU IS THIS A SURGERY?","TIU IDENTIFY SURGERY CLASS","TIU LONG LIST SURGERY TITLES" D INSERT(MENU,RPC)

 Q

 ;

INSERT(OPTION,RPC) ; Call FM Updater with each RPC

 ; Input  -- OPTION   Option file (#19) Name field (#.01)

 ;           RPC      RPC sub-file (#19.05) RPC field (#.01)

 ; Output -- None

 N FDA,FDAIEN,ERR,DIERR

 S FDA(19,"?1,",.01)=OPTION

 S FDA(19.05,"?+2,?1,",.01)=RPC

 D UPDATE^DIE("E","FDA","FDAIEN","ERR")

 Q

 ;

MAIL ; send bulletin of installation time

 N COUNT,DIFROM,I,START,TEXT,XMDUZ,XMSUB,XMTEXT,XMY

 S COUNT=0

 S XMSUB="Version "_$P($T(VERSION),";;",2)_" Installed"

 S XMDUZ="CPRS PACKAGE"

 F I="G.CPRS GUI INSTALL@DOMAIN.NAME",DUZ S XMY(I)=""

 S XMTEXT="TEXT("

 ;

 S X=$P($T(VERSION),";;",2)

 D LINE("Version "_X_" has been installed.")

 D LINE(" ")

 D LINE("Install complete:  "_$$FMTE^XLFDT($$NOW^XLFDT()))

 ;

 D ^XMD

 Q

 ;

PAROUT ; Remove entries, parameter "ORWT TOOLS RPT SETTINGS OFF" if found.

 ;

 ; Remove all instances of parameter:

 N DA,DIK,PAR,ENT,INST,DIRUT,DUOUT,DTOUT,ORIEN

 S PAR="ORWT TOOLS RPT SETTINGS OFF"

 ;

 S ORIEN=0

 S ORIEN=$O(^XTV(8989.51,"B",PAR,ORIEN))

 S ORIEN=+ORIEN

 I 'ORIEN Q

 ;

 S ENT=0

 F  S ENT=$O(^XTV(8989.5,"AC",ORIEN,ENT)) Q:'ENT  D

 .S INST=0

 .F  S INST=$O(^XTV(8989.5,"AC",ORIEN,ENT,INST)) Q:INST=""  D  Q

 ..D DEL^XPAR(ENT,ORIEN,INST)

 ;

 ; Remove parameter definition itself:

 S DIK="^XTV(8989.51,"

 S DA=ORIEN

 D ^DIK

 ;

 Q

 ;

LINE(DATA)      ; set text into array

 S COUNT=COUNT+1

 S TEXT(COUNT)=DATA

 Q

 ;

VERSION ;;19.15

ORY148    ;SLC/PKS -- postinit rtn for OR*3*148 ;6/21/02  12:04 [7/23/02 2:15pm]

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**148**;Dec 17, 1997

 +2       ;

 +3        QUIT 

 +4       ;

PRE       ; -- preinit

 +1       ;

 +2        QUIT 

 +3       ;

POST      ; -- postinit

 +1       ;

 +2        NEW VER,ORCOUNT

 +3       ;

 +4        SET VER=$PIECE($TEXT(VERSION^ORY148),";",3)

 +5        DO USERSET

 +6        DO PAROUT

 +7        IF +$$PATCH^XPDUTL("TIU*1.0*109")

               DO CPREG

 +8        IF +$$PATCH^XPDUTL("TIU*1.0*112")

               DO SURGREG

 +9        DO MAIL

 +10      ;

 +11       QUIT 

 +12      ;

USERSET   ; Queue background task to set user default settings.

 +1       ;

 +2        NEW ZTRTN,ZTDESC,ZTIO,ZTSAVE,ZTDTH,ZTSK

 +3       ;

 +4        SET ZTRTN="DQSET^ORY148"

           SET ZTDESC="OR*3*148 Post Install"

           SET ZTIO=""

           SET ZTSAVE("DUZ")=""

           SET ZTDTH=$HOROLOG

 +5        DO ^%ZTLOAD

 +6        IF $GET(ZTSK)

               DO MES^XPDUTL("User defaults for OR*3*148 queued as task number "_ZTSK_".")

 +7        IF '$GET(ZTSK)

               DO MES^XPDUTL("User defaults task did not queue")

 +8       ;

 +9        QUIT 

 +10      ;

DQSET     ; Queue background task to set user default settings.

 +1       ;

 +2        SET ORCOUNT=0

 +3        SET ^TMP("ORY148",$JOB,1)="Background task for OR*3*148 has completed."

 +4        SET ^TMP("ORY148",$JOB,2)=" "

 +5        SET ^TMP("ORY148",$JOB,3)="The following problems were encountered:"

 +6        SET ^TMP("ORY148",$JOB,4)=" "

 +7        SET ORCOUNT=4

 +8       ;

 +9       ; Set user default settings:

 +10       DO DEFTABS

 +11       IF ORCOUNT=4

               SET ^TMP("ORY148",$JOB,5)="No problems encountered."

 +12      ;

 +13      ; Send message with results to user, postmaster:

 +14       NEW XMSUB,XMTEXT,SMDUZ,SMY

 +15      ; Message subject.

           SET XMSUB="Patch OR*3*148 Post-Install Complete"

 +16      ; Message "from."

           SET XMDUZ="Patch OR*3*148 Post Install"

 +17      ; To user,postmaster.

           SET XMY(.5)=""

           IF $GET(DUZ)

               SET XMY(DUZ)=""

 +18      ; Text for message.

           SET XMTEXT="^TMP(""ORY148"",$J,"

 +19       DO ^XMD

 +20       KILL ^TMP("ORY148",$JOB)

 +21      ;

 +22       QUIT 

 +23      ;

DEFTABS   ; Default tab, restricted patient list entries for GUI users.

 +1       ;

 +2        NEW ORZ,ORZZ,OROPT,ORUSER,DIE

 +3       ;

 +4        SET OROPT="OR CPRS GUI CHART"

 +5        SET OROPT=$$OPTLK^XQCS(OROPT)

 +6        SET OROPT=+OROPT

 +7        IF OROPT<1

               Begin DoDot:1

 +8                WRITE !,"No OR CPRS GUI CHART Option found!"

               End DoDot:1

               QUIT 

 +9       ;

 +10      ; Establish loop to order through users:

 +11       SET ORUSER=0

 +12       FOR 

               SET ORUSER=$ORDER(^VA(200,ORUSER))

               IF 'ORUSER>0

                   QUIT 

               Begin DoDot:1

 +13               SET ORZ=0

 +14      ; Have OR CPRS GUI CHART option?

                   SET ORZ=$$ACCESS^XQCHK(ORUSER,OROPT)

 +15               SET ORZ=+ORZ

 +16               SET ORZZ=$GET(^VA(200,ORUSER,0))

 +17               SET ORZZ=$PIECE(ORZZ,U,4)

 +18               IF ((ORZ>0)!(ORZZ["@"))

                       Begin DoDot:2

 +19      ;

 +20      ; Set default of "COR" for CPRS tabs multiple:

 +21                       NEW ORFDA,ORIEN,ORERR

 +22                       SET ORIEN(1)=ORUSER

 +23                       SET ORFDA(200.010113,"+2,"_ORUSER_",",.01)=1

 +24                       SET ORFDA(200.010113,"+2,"_ORUSER_",",.02)=DT

 +25                       IF ('$DATA(^VA(200,ORUSER,"ORD",0)))

                               DO UPDATE^DIE("","ORFDA","ORIEN","ORERR")

 +26                       IF $DATA(ORERR)

                               Begin DoDot:3

 +27      ;

 +28      ; Send installation error message to run under Taskman:

 +29                               SET ORCOUNT=ORCOUNT+1

 +30                               SET ^TMP("ORY148",$JOB,ORCOUNT)="Could not create default COR Tab entry for user "_ORUSER_"."

                               End DoDot:3

 +31      ;

 +32      ; Set default of "N" for restricted patient list field:

 +33                       NEW ORFDA,ORIEN,ORERR

 +34                       SET ORIEN(1)=ORUSER

 +35                       SET ORFDA(200,ORUSER_",",101.01)=0

 +36                       IF ('$DATA(^VA(200,ORUSER,101)))

                               DO UPDATE^DIE("","ORFDA","ORIEN","ORERR")

 +37                       IF $DATA(ORERR)

                               Begin DoDot:3

 +38      ;

 +39      ; Send installation error message to run under Taskman:

 +40                               SET ORCOUNT=ORCOUNT+1

 +41                               SET ^TMP("ORY148",$JOB,ORCOUNT)="Could not make RPL default NO entry for user "_ORUSER_"."

                               End DoDot:3

 +42      ;

 +43      ; Clean up after DB call.

                           DO CLEAN^DILF

                       End DoDot:2

               End DoDot:1

 +44      ;

 +45       QUIT 

 +46      ;

CPREG     ; Register TIU Clinical Procedures RPCs if TIU*1.0*109 present

 +1        NEW MENU,RPC

 +2        SET MENU="OR CPRS GUI CHART"

 +3        FOR RPC="TIU IS THIS A CLINPROC?","TIU IDENTIFY CLINPROC CLASS","TIU LONG LIST CLINPROC TITLES"

               DO INSERT(MENU,RPC)

 +4        QUIT 

 +5       ;

SURGREG   ; Register TIU SURGERY RPCs if TIU*1.0*112 present

 +1        NEW MENU,RPC

 +2        SET MENU="OR CPRS GUI CHART"

 +3        FOR RPC="TIU IS THIS A SURGERY?","TIU IDENTIFY SURGERY CLASS","TIU LONG LIST SURGERY TITLES"

               DO INSERT(MENU,RPC)

 +4        QUIT 

 +5       ;

INSERT(OPTION,RPC) ; Call FM Updater with each RPC

 +1       ; Input  -- OPTION   Option file (#19) Name field (#.01)

 +2       ;           RPC      RPC sub-file (#19.05) RPC field (#.01)

 +3       ; Output -- None

 +4        NEW FDA,FDAIEN,ERR,DIERR

 +5        SET FDA(19,"?1,",.01)=OPTION

 +6        SET FDA(19.05,"?+2,?1,",.01)=RPC

 +7        DO UPDATE^DIE("E","FDA","FDAIEN","ERR")

 +8        QUIT 

 +9       ;

MAIL      ; send bulletin of installation time

 +1        NEW COUNT,DIFROM,I,START,TEXT,XMDUZ,XMSUB,XMTEXT,XMY

 +2        SET COUNT=0

 +3        SET XMSUB="Version "_$PIECE($TEXT(VERSION),";;",2)_" Installed"

 +4        SET XMDUZ="CPRS PACKAGE"

 +5        FOR I="G.CPRS GUI INSTALL@DOMAIN.NAME",DUZ

               SET XMY(I)=""

 +6        SET XMTEXT="TEXT("

 +7       ;

 +8        SET X=$PIECE($TEXT(VERSION),";;",2)

 +9        DO LINE("Version "_X_" has been installed.")

 +10       DO LINE(" ")

 +11       DO LINE("Install complete:  "_$$FMTE^XLFDT($$NOW^XLFDT()))

 +12      ;

 +13       DO ^XMD

 +14       QUIT 

 +15      ;

PAROUT    ; Remove entries, parameter "ORWT TOOLS RPT SETTINGS OFF" if found.

 +1       ;

 +2       ; Remove all instances of parameter:

 +3        NEW DA,DIK,PAR,ENT,INST,DIRUT,DUOUT,DTOUT,ORIEN

 +4        SET PAR="ORWT TOOLS RPT SETTINGS OFF"

 +5       ;

 +6        SET ORIEN=0

 +7        SET ORIEN=$ORDER(^XTV(8989.51,"B",PAR,ORIEN))

 +8        SET ORIEN=+ORIEN

 +9        IF 'ORIEN

               QUIT 

 +10      ;

 +11       SET ENT=0

 +12       FOR 

               SET ENT=$ORDER(^XTV(8989.5,"AC",ORIEN,ENT))

               IF 'ENT

                   QUIT 

               Begin DoDot:1

 +13               SET INST=0

 +14               FOR 

                       SET INST=$ORDER(^XTV(8989.5,"AC",ORIEN,ENT,INST))

                       IF INST=""

                           QUIT 

                       Begin DoDot:2

 +15                       DO DEL^XPAR(ENT,ORIEN,INST)

                       End DoDot:2

                       QUIT 

               End DoDot:1

 +16      ;

 +17      ; Remove parameter definition itself:

 +18       SET DIK="^XTV(8989.51,"

 +19       SET DA=ORIEN

 +20       DO ^DIK

 +21      ;

 +22       QUIT 

 +23      ;

LINE(DATA) ; set text into array

 +1        SET COUNT=COUNT+1

 +2        SET TEXT(COUNT)=DATA

 +3        QUIT 

 +4       ;

VERSION   ;;19.15