- 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 Feb 19, 2025@00:08:07 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
