- ORY132 ;SLC/REV -- postinit rtn for OR*3*132 ;12/13/01 06:25 [4/29/02 4:53pm]
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**132**;Dec 17, 1997
- ;
- Q
- ;
- PRE ; -- preinit
- Q
- ;
- POST ; -- postinit
- N VER
- S VER=$P($T(VERSION^ORY132),";",3)
- I +$$PATCH^XPDUTL("TIU*1.0*109") D CPREG
- I +$$PATCH^XPDUTL("TIU*1.0*112") D SURGREG
- D SURGRPT
- D SETVAL
- D TASKJOB
- D MAIL
- ;
- Q
- ;
- TASKJOB ; Queue background task to update Order file for Alert Results field.
- ;
- N ZTRTN,ZTDESC,ZTIO,ZTSAVE,ZTDTH,ZTSK
- ;
- S ZTRTN="FIXALERT^ORY132",ZTDESC="OR*3*132 Post Install",ZTIO="",ZTSAVE("DUZ")="",ZTDTH=$H
- D ^%ZTLOAD
- I $G(ZTSK) D MES^XPDUTL("Order file update for OR*3*132 queued as task number "_ZTSK_".")
- I '$G(ZTSK) D MES^XPDUTL("Order file update task did not queue")
- ;
- Q
- ;
- SETVAL ;
- N ORP,ORT
- S ORP="ORWRP REPORT LIST",ORT=$O(^ORD(101.24,"B","ORRPW DOD",0))
- I ORT D PUT^XPAR("PKG",ORP,8,ORT)
- 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
- ;
- SURGRPT ; Add Surgery report to Reports tab
- N ORSURG,ORI,ORP,ORT,ORS,ORLST,ORERR,FOUND
- S ORP="ORWRP REPORT LIST",ORT=$O(^ORD(101.24,"B","ORRP SURGERIES",0))
- S ORSURG=$O(^ORD(101.24,"B","ORRP SURGERIES",0)),ORI=0,FOUND=0
- D GETLST^XPAR(.ORLST,"PKG","ORWRP REPORT LIST","Q",.ORERR)
- F S ORI=$O(ORLST(ORI)) Q:+ORI=0!(FOUND) D
- . I $P(ORLST(ORI),U,2)=ORSURG S FOUND=1
- Q:+FOUND
- S ORS=+ORLST(ORLST)+5
- D PUT^XPAR("PKG",ORP,ORS,ORT)
- Q
- ;
- FIXALERT ; convert "1" in ALERT ON RESULTS field to Ordering Provider
- N ORX,ORDUZ,ORTEXT
- S ORX=0 F S ORX=$O(^OR(100,ORX)) Q:+$G(ORX)<1 D
- .I $P($G(^OR(100,ORX,3)),U,10)=1 D
- ..S ORDUZ=$$ORDERER^ORQOR2(ORX)
- ..I +$G(ORDUZ)>1 S $P(^OR(100,ORX,3),U,10)=+$G(ORDUZ)
- S TEXT(1)="Background task for OR*3*132 has completed."
- ;
- ; Send message to user, postmaster:
- N XMSUB,XMTEXT,SMDUZ,SMY
- S XMSUB="Patch OR*3*132 Tasked Post-Install Complete" ; Msg subject.
- S XMDUZ="Patch OR*3*132 Tasked Post Install" ; Message "from."
- S XMY(.5)="" S:$G(DUZ) XMY(DUZ)="" ; To user,postmaster.
- S XMTEXT="TEXT("
- D ^XMD
- ;
- Q
- ;
- SENDPAR(ANAME) ; Return true if the current parameter should be sent
- I ANAME="ORCH INITIAL TAB" Q 1
- I ANAME="ORWOR SHOW SURGERY TAB" Q 1
- I ANAME="ORWOR PKI USE" Q 1
- Q 0
- 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@ISC-SLC.DOMAIN.EXT",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
- ;
- LINE(DATA) ; set text into array
- S COUNT=COUNT+1
- S TEXT(COUNT)=DATA
- Q
- ;
- VERSION ;;19.7
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY132 3542 printed Jan 18, 2025@03:39:35 Page 2
- ORY132 ;SLC/REV -- postinit rtn for OR*3*132 ;12/13/01 06:25 [4/29/02 4:53pm]
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**132**;Dec 17, 1997
- +2 ;
- +3 QUIT
- +4 ;
- PRE ; -- preinit
- +1 QUIT
- +2 ;
- POST ; -- postinit
- +1 NEW VER
- +2 SET VER=$PIECE($TEXT(VERSION^ORY132),";",3)
- +3 IF +$$PATCH^XPDUTL("TIU*1.0*109")
- DO CPREG
- +4 IF +$$PATCH^XPDUTL("TIU*1.0*112")
- DO SURGREG
- +5 DO SURGRPT
- +6 DO SETVAL
- +7 DO TASKJOB
- +8 DO MAIL
- +9 ;
- +10 QUIT
- +11 ;
- TASKJOB ; Queue background task to update Order file for Alert Results field.
- +1 ;
- +2 NEW ZTRTN,ZTDESC,ZTIO,ZTSAVE,ZTDTH,ZTSK
- +3 ;
- +4 SET ZTRTN="FIXALERT^ORY132"
- SET ZTDESC="OR*3*132 Post Install"
- SET ZTIO=""
- SET ZTSAVE("DUZ")=""
- SET ZTDTH=$HOROLOG
- +5 DO ^%ZTLOAD
- +6 IF $GET(ZTSK)
- DO MES^XPDUTL("Order file update for OR*3*132 queued as task number "_ZTSK_".")
- +7 IF '$GET(ZTSK)
- DO MES^XPDUTL("Order file update task did not queue")
- +8 ;
- +9 QUIT
- +10 ;
- SETVAL ;
- +1 NEW ORP,ORT
- +2 SET ORP="ORWRP REPORT LIST"
- SET ORT=$ORDER(^ORD(101.24,"B","ORRPW DOD",0))
- +3 IF ORT
- DO PUT^XPAR("PKG",ORP,8,ORT)
- +4 QUIT
- 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 ;
- SURGRPT ; Add Surgery report to Reports tab
- +1 NEW ORSURG,ORI,ORP,ORT,ORS,ORLST,ORERR,FOUND
- +2 SET ORP="ORWRP REPORT LIST"
- SET ORT=$ORDER(^ORD(101.24,"B","ORRP SURGERIES",0))
- +3 SET ORSURG=$ORDER(^ORD(101.24,"B","ORRP SURGERIES",0))
- SET ORI=0
- SET FOUND=0
- +4 DO GETLST^XPAR(.ORLST,"PKG","ORWRP REPORT LIST","Q",.ORERR)
- +5 FOR
- SET ORI=$ORDER(ORLST(ORI))
- if +ORI=0!(FOUND)
- QUIT
- Begin DoDot:1
- +6 IF $PIECE(ORLST(ORI),U,2)=ORSURG
- SET FOUND=1
- End DoDot:1
- +7 if +FOUND
- QUIT
- +8 SET ORS=+ORLST(ORLST)+5
- +9 DO PUT^XPAR("PKG",ORP,ORS,ORT)
- +10 QUIT
- +11 ;
- FIXALERT ; convert "1" in ALERT ON RESULTS field to Ordering Provider
- +1 NEW ORX,ORDUZ,ORTEXT
- +2 SET ORX=0
- FOR
- SET ORX=$ORDER(^OR(100,ORX))
- if +$GET(ORX)<1
- QUIT
- Begin DoDot:1
- +3 IF $PIECE($GET(^OR(100,ORX,3)),U,10)=1
- Begin DoDot:2
- +4 SET ORDUZ=$$ORDERER^ORQOR2(ORX)
- +5 IF +$GET(ORDUZ)>1
- SET $PIECE(^OR(100,ORX,3),U,10)=+$GET(ORDUZ)
- End DoDot:2
- End DoDot:1
- +6 SET TEXT(1)="Background task for OR*3*132 has completed."
- +7 ;
- +8 ; Send message to user, postmaster:
- +9 NEW XMSUB,XMTEXT,SMDUZ,SMY
- +10 ; Msg subject.
- SET XMSUB="Patch OR*3*132 Tasked Post-Install Complete"
- +11 ; Message "from."
- SET XMDUZ="Patch OR*3*132 Tasked Post Install"
- +12 ; To user,postmaster.
- SET XMY(.5)=""
- if $GET(DUZ)
- SET XMY(DUZ)=""
- +13 SET XMTEXT="TEXT("
- +14 DO ^XMD
- +15 ;
- +16 QUIT
- +17 ;
- SENDPAR(ANAME) ; Return true if the current parameter should be sent
- +1 IF ANAME="ORCH INITIAL TAB"
- QUIT 1
- +2 IF ANAME="ORWOR SHOW SURGERY TAB"
- QUIT 1
- +3 IF ANAME="ORWOR PKI USE"
- QUIT 1
- +4 QUIT 0
- 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@ISC-SLC.DOMAIN.EXT",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 ;
- LINE(DATA) ; set text into array
- +1 SET COUNT=COUNT+1
- +2 SET TEXT(COUNT)=DATA
- +3 QUIT
- +4 ;
- VERSION ;;19.7