ORY377B ;ISP/RFR - ENVIRONMENT CHECK FOR CPRS VERSION 31 ;Jun 20, 2018@11:34
;;3.0;ORDER ENTRY/RESULTS REPORTING;**377**;Dec 17, 1997;Build 582
ENV ;ENVIRONMENT CHECK SECTION
;CHECK EXISTING NOTIFICATION(S)
N ORENTRY,ORERROR,OROW,ORI,ORCHKSUM
F ORI=79,84:1:87,90 D Q:$G(ORERROR)
.Q:$D(^ORD(100.9,ORI))<10
.S ORCHKSUM=$$NOTCHKSM(ORI)
.N ORTMSTMP,ORASK
.S ORASK=1,ORTMSTMP=0
.F S ORTMSTMP=$O(@XPDGREF@("ORCHKSUMS",ORI,ORTMSTMP)) Q:'ORTMSTMP!('ORASK) D
..S:$G(@XPDGREF@("ORCHKSUMS",ORI,ORTMSTMP))=ORCHKSUM ORASK=0
.S:ORASK ORERROR=$$OW(1,ORI)
Q:$G(XPDQUIT)=2
Q
OW(OROW,DA) ;ASK THE USER TO CONTINUE WITH INSTALLATION
Q:'$G(OROW) 0
N DIC,DIQ,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
S DIC="^ORD(100.9,",DIQ(0)="CR"
D EN^DIQ
W !,"The above notification will be overwritten.",!
S DIR(0)="Y^",DIR("A")="Do you wish to proceed with installation of this patch",DIR("B")="NO"
D ^DIR
W !
S:+$G(Y)=0 XPDQUIT=2
Q:$G(XPDQUIT)=2 1
Q 0
PRE ; PRE-TRANSPORTATION SECTION
;SAVE OE/RR NOTIFICATION CHECKSUMS FOR COMPARE AT SITE
N ORI,ORNOW
S ORNOW=$$NOW^XLFDT
S ^XTMP("ORCHKSUMS",0)=$$FMADD^XLFDT(DT,1095)_U_DT_U_"OE/RR NOTIFICATION CHECKSUMS"
F ORI=79,84:1:87,90 D
.N ORTMSTMP,ORCHKSUM,ORSAVE
.S ORSAVE=1,ORCHKSUM=$$NOTCHKSM(ORI)
.S ORTMSTMP=0 F S ORTMSTMP=$O(^XTMP("ORCHKSUMS",ORI,ORTMSTMP)) Q:'ORTMSTMP!('ORSAVE) D
..S:$G(^XTMP("ORCHKSUMS",ORI,ORTMSTMP))=ORCHKSUM ORSAVE=0
.S:ORSAVE ^XTMP("ORCHKSUMS",ORI,ORNOW)=ORCHKSUM
M @XPDGREF@("ORCHKSUMS")=^XTMP("ORCHKSUMS")
K @XPDGREF@("ORCHKSUMS",0)
Q
NOTCHKSM(ORI) ;CALCULATE OE/RR NOTIFICATION CHECKSUM
;INPUT: ORI - IEN IN FILE #100.9
N ORRET,ADDR,DATA,CHAR
K ^TMP($J,"ORCHKSUM")
M ^TMP($J,"ORCHKSUM")=^ORD(100.9,ORI)
;STRIP TRAILING CARETS FROM ALL NODES
S ADDR=$NA(^TMP($J,"ORCHKSUM")) F S ADDR=$Q(@ADDR) Q:ADDR="" D
.S DATA=$G(@ADDR)
.F CHAR=$L(DATA):-1:1 Q:$E(DATA,CHAR)'=U S DATA=$E(DATA,1,($L(DATA)-1))
.S @ADDR=DATA
I $P($G(^TMP($J,"ORCHKSUM",6)),U,2)?1.N D
.S $P(^TMP($J,"ORCHKSUM",6),U,2)=$$EXTERNAL^DILFD(100.9,6.2,"",$P(^TMP($J,"ORCHKSUM",6),U,2))
I $P($G(^TMP($J,"ORCHKSUM",6)),U,4)?1.N D
.S $P(^TMP($J,"ORCHKSUM",6),U,4)=$$EXTERNAL^DILFD(100.9,6.4,"",$P(^TMP($J,"ORCHKSUM",6),U,4))
I $P($G(^TMP($J,"ORCHKSUM",6)),U,5)?1.N D
.S $P(^TMP($J,"ORCHKSUM",6),U,5)=$$EXTERNAL^DILFD(100.9,7,"",$P(^TMP($J,"ORCHKSUM",6),U,5))
S ORRET=$$CHKSUM^XUSESIG1($NA(^TMP($J,"ORCHKSUM")))
K ^TMP($J,"ORCHKSUM")
Q ORRET
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY377B 2454 printed Apr 09, 2024@21:34:18 Page 2
ORY377B ;ISP/RFR - ENVIRONMENT CHECK FOR CPRS VERSION 31 ;Jun 20, 2018@11:34
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**377**;Dec 17, 1997;Build 582
ENV ;ENVIRONMENT CHECK SECTION
+1 ;CHECK EXISTING NOTIFICATION(S)
+2 NEW ORENTRY,ORERROR,OROW,ORI,ORCHKSUM
+3 FOR ORI=79,84:1:87,90
Begin DoDot:1
+4 if $DATA(^ORD(100.9,ORI))<10
QUIT
+5 SET ORCHKSUM=$$NOTCHKSM(ORI)
+6 NEW ORTMSTMP,ORASK
+7 SET ORASK=1
SET ORTMSTMP=0
+8 FOR
SET ORTMSTMP=$ORDER(@XPDGREF@("ORCHKSUMS",ORI,ORTMSTMP))
if 'ORTMSTMP!('ORASK)
QUIT
Begin DoDot:2
+9 if $GET(@XPDGREF@("ORCHKSUMS",ORI,ORTMSTMP))=ORCHKSUM
SET ORASK=0
End DoDot:2
+10 if ORASK
SET ORERROR=$$OW(1,ORI)
End DoDot:1
if $GET(ORERROR)
QUIT
+11 if $GET(XPDQUIT)=2
QUIT
+12 QUIT
OW(OROW,DA) ;ASK THE USER TO CONTINUE WITH INSTALLATION
+1 if '$GET(OROW)
QUIT 0
+2 NEW DIC,DIQ,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+3 SET DIC="^ORD(100.9,"
SET DIQ(0)="CR"
+4 DO EN^DIQ
+5 WRITE !,"The above notification will be overwritten.",!
+6 SET DIR(0)="Y^"
SET DIR("A")="Do you wish to proceed with installation of this patch"
SET DIR("B")="NO"
+7 DO ^DIR
+8 WRITE !
+9 if +$GET(Y)=0
SET XPDQUIT=2
+10 if $GET(XPDQUIT)=2
QUIT 1
+11 QUIT 0
PRE ; PRE-TRANSPORTATION SECTION
+1 ;SAVE OE/RR NOTIFICATION CHECKSUMS FOR COMPARE AT SITE
+2 NEW ORI,ORNOW
+3 SET ORNOW=$$NOW^XLFDT
+4 SET ^XTMP("ORCHKSUMS",0)=$$FMADD^XLFDT(DT,1095)_U_DT_U_"OE/RR NOTIFICATION CHECKSUMS"
+5 FOR ORI=79,84:1:87,90
Begin DoDot:1
+6 NEW ORTMSTMP,ORCHKSUM,ORSAVE
+7 SET ORSAVE=1
SET ORCHKSUM=$$NOTCHKSM(ORI)
+8 SET ORTMSTMP=0
FOR
SET ORTMSTMP=$ORDER(^XTMP("ORCHKSUMS",ORI,ORTMSTMP))
if 'ORTMSTMP!('ORSAVE)
QUIT
Begin DoDot:2
+9 if $GET(^XTMP("ORCHKSUMS",ORI,ORTMSTMP))=ORCHKSUM
SET ORSAVE=0
End DoDot:2
+10 if ORSAVE
SET ^XTMP("ORCHKSUMS",ORI,ORNOW)=ORCHKSUM
End DoDot:1
+11 MERGE @XPDGREF@("ORCHKSUMS")=^XTMP("ORCHKSUMS")
+12 KILL @XPDGREF@("ORCHKSUMS",0)
+13 QUIT
NOTCHKSM(ORI) ;CALCULATE OE/RR NOTIFICATION CHECKSUM
+1 ;INPUT: ORI - IEN IN FILE #100.9
+2 NEW ORRET,ADDR,DATA,CHAR
+3 KILL ^TMP($JOB,"ORCHKSUM")
+4 MERGE ^TMP($JOB,"ORCHKSUM")=^ORD(100.9,ORI)
+5 ;STRIP TRAILING CARETS FROM ALL NODES
+6 SET ADDR=$NAME(^TMP($JOB,"ORCHKSUM"))
FOR
SET ADDR=$QUERY(@ADDR)
if ADDR=""
QUIT
Begin DoDot:1
+7 SET DATA=$GET(@ADDR)
+8 FOR CHAR=$LENGTH(DATA):-1:1
if $EXTRACT(DATA,CHAR)'=U
QUIT
SET DATA=$EXTRACT(DATA,1,($LENGTH(DATA)-1))
+9 SET @ADDR=DATA
End DoDot:1
+10 IF $PIECE($GET(^TMP($JOB,"ORCHKSUM",6)),U,2)?1.N
Begin DoDot:1
+11 SET $PIECE(^TMP($JOB,"ORCHKSUM",6),U,2)=$$EXTERNAL^DILFD(100.9,6.2,"",$PIECE(^TMP($JOB,"ORCHKSUM",6),U,2))
End DoDot:1
+12 IF $PIECE($GET(^TMP($JOB,"ORCHKSUM",6)),U,4)?1.N
Begin DoDot:1
+13 SET $PIECE(^TMP($JOB,"ORCHKSUM",6),U,4)=$$EXTERNAL^DILFD(100.9,6.4,"",$PIECE(^TMP($JOB,"ORCHKSUM",6),U,4))
End DoDot:1
+14 IF $PIECE($GET(^TMP($JOB,"ORCHKSUM",6)),U,5)?1.N
Begin DoDot:1
+15 SET $PIECE(^TMP($JOB,"ORCHKSUM",6),U,5)=$$EXTERNAL^DILFD(100.9,7,"",$PIECE(^TMP($JOB,"ORCHKSUM",6),U,5))
End DoDot:1
+16 SET ORRET=$$CHKSUM^XUSESIG1($NAME(^TMP($JOB,"ORCHKSUM")))
+17 KILL ^TMP($JOB,"ORCHKSUM")
+18 QUIT ORRET
