OROCAPI1 ;SLC/JMH - ORDER CHECK INSTANCES FILE APIS; 02/04/2015 12:18 ;05/17/17 09:34
;;3.0;ORDER ENTRY/RESULTS REPORTING;**293,346,345,269,405**;Dec 17, 1997;Build 211
SAVEOC(ORL,RET) ;SAVE A GROUP OF ORDER CHECKS
;ORL=LIST OF ORDER CHECKS
;(D0,1)=ORDER NUMBER (FILE 100)^
; OCCURANCE DESCRIPTOR^
; USER (FILE 200)^
; OCCURANCE D/T^
; ORDER CHECK NUMBER (FILE 100.8)^
; CLINICAL DANGER LEVEL
; (D0,2,D1)=ORDER CHECK NARRATIVE
; (D0,3)=OVERRIDE REASON
; (D0,4)=COMMENT FOR A REMOTE ALLERGY
;RET=RETURN ARRAY OF IENS BY ORL(D0)
; RET(D0,IEN)=""
N I S I=0 F S I=$O(ORL(I)) Q:'I D
.N DA,DR,DIC,X,Y,DIE,ORSTATUS,ORN,ORDANG,DW,DV,%,D,DC,DE,DH,DI,DIEL,DIFLD,DIP,DK,DM,DP,DQ,ORKMSG,DTOUT
.N ORFDART,ORIENRT,ORMSGRT,J,ERROR,IEN
.S ORN=+ORL(I,1)
.Q:'ORN!('$D(^OR(100,ORN)))
.Q:'$P(ORL(I,1),U,5) ;QUIT IF NO ORDER CHECK NUMBER
.Q:'$D(ORL(I,2)) ;QUIT IF NO ORDER CHECK TEXT
.I $G(FLDS("ORDUZ"))]"" S $P(ORL(I,1),"^",3)=$G(FLDS("ORDUZ"))
.K ^TMP("DIERR",$J)
.S ORFDART(100.05,"+1,",.01)=ORN
.D UPDATE^DIE("","ORFDART","ORIENRT","ORMSGRT")
.I $D(ORIENRT(1)) S DA=ORIENRT(1)
.Q:'$G(DA)
.S RET(I,DA)=""
.S DIC="^ORD(100.05,",DIC(0)="F",X=ORN
.S DIE=DIC,ORSTATUS=$P($G(^OR(100,ORN,3)),U,3),ORDANG=$S($P($G(ORL(I,1)),U,6):$P($G(ORL(I,1)),U,6),1:$$GET^XPAR("ALL","ORK CLINICAL DANGER LEVEL",$P($G(ORL(I,1)),U,5),"I"))
.S DR="1////"_ORSTATUS_";2////"_$P($G(ORL(I,1)),U,2)_";3////"_$P($G(ORL(I,1)),U,3)_";4////"_$P($G(ORL(I,1)),U,4)_";5////"_$P($G(ORL(I,1)),U,5)_";6////"_ORDANG_";7///"_$TR($G(ORL(I,3)),";",",")
.D ^DIE
.D WP^DIE(100.05,DA_",",8,,"ORL("_I_",2)","ERROR")
.S J=0 F S J=$O(ORL(I,2,J)) Q:'J S ORKMSG=$G(ORKMSG)_ORL(I,2,J)
.;SAVE ALLERGY DATA IF IT EXISTS
.N CRC16,ORDA
.S CRC16=$$CRC16^XLFCRC(ORKMSG),ORDA=DA
.I $D(^TMP("OROCIDATA",$J,CRC16)) D
..N FDA,CLASS,ING,SIGN,ERROR,NUM
..S FDA(100.05,ORDA_",",84)=$G(^TMP("OROCIDATA",$J,CRC16,100.05,84))
..D FILE^DIE("K","FDA","ERROR")
..S NUM=0 F S NUM=$O(^TMP("OROCIDATA",$J,CRC16,100.517,NUM)) Q:'NUM D
...I $G(ORL(I,4))]"" S ^TMP("OROCIDATA",$J,CRC16,100.517,NUM,11)=ORL(I,4)
...M FDA(100.517,"+1,"_ORDA_",")=^TMP("OROCIDATA",$J,CRC16,100.517,NUM)
...D:$D(FDA) UPDATE^DIE(,"FDA","IEN","ERROR")
...S CLASS="" F S CLASS=$O(^TMP("OROCIDATA",$J,CRC16,"CLASS",NUM,CLASS)) Q:$G(CLASS)="" D
....S FDA(100.5173,CLASS_IEN(1)_","_ORDA_",",.01)=^TMP("OROCIDATA",$J,CRC16,"CLASS",NUM,CLASS)
...S ING="" F S ING=$O(^TMP("OROCIDATA",$J,CRC16,"INGREDIENT",NUM,ING)) Q:$G(ING)="" D
....S FDA(100.5174,ING_IEN(1)_","_ORDA_",",.01)=^TMP("OROCIDATA",$J,CRC16,"INGREDIENT",NUM,ING)
...S SIGN="" F S SIGN=$O(^TMP("OROCIDATA",$J,CRC16,"SIGN",NUM,SIGN)) Q:$G(SIGN)="" D
....S FDA(100.5175,SIGN_IEN(1)_","_ORDA_",",.01)=^TMP("OROCIDATA",$J,CRC16,"SIGN",NUM,SIGN)
...D:$D(FDA) UPDATE^DIE(,"FDA",,"ERROR")
...K FDA,IEN
..K ^TMP("OROCIDATA",$J,CRC16)
Q
GETOC1(IEN,RET) ;GET A SINGLE ORDER CHECK
;IEN = 100.05 IEN
;RET = RETURNED 100.05 DATA FOR IEN
K RET
Q:'$G(IEN)
Q:'$D(^ORD(100.05,IEN))
S RET(IEN,0)=$G(^ORD(100.05,IEN,0))
S RET(IEN,1)=$G(^ORD(100.05,IEN,1))
S $P(RET(IEN,1),U,1)=$P(^ORD(100.8,$P(RET(IEN,1),U,1),0),U,1)_";"_$P(RET(IEN,1),U,1)
M RET(IEN,"OC")=^ORD(100.05,IEN,2)
K RET(IEN,"OC",0)
M RET(IEN,"OR")=^ORD(100.05,IEN,3)
K RET(IEN,"OR",0)
D REMOTE ;TDP
M RET(IEN,"OI")=^OR(100,$P(RET(IEN,0),U,1),.1)
N OIEN
S OIEN="" F S OIEN=$O(RET(IEN,"OI",OIEN)) Q:$G(OIEN)="" D
.I +OIEN=0 K RET(IEN,"OI",OIEN) Q
.S RET(IEN,"OI",OIEN,0)=$P(^ORD(101.43,RET(IEN,"OI",OIEN,0),0),U,1,2)
Q
GETOC2(ORD,RET) ;GET ALL 100.05 IENS FOR A SPECIFIC ORDER
;ORD = 100 IEN
;RET = LIST OF 100.05 IENS
K RET
Q:'$G(ORD)
N I S I=0 F S I=$O(^ORD(100.05,"B",ORD,I)) Q:'I S RET(ORD,I)=""
Q
GETOC3(ORD,OCC,RET) ;GET ALL 100.05 IENS FOR A SPECIFIC ORDER/OCCURANCE PAIR
;ORD = 100 IEN
;OCC = OCCURANCE STRING
;RET = LIST OF 100.05 IENS
K RET
Q:'$G(ORD)
Q:'$L(OCC)
N I S I=0 F S I=$O(^ORD(100.05,"C",ORD,OCC,I)) Q:'I S RET(ORD,I)=""
Q
GETOC4(ORD,RET) ;GET DATA FOR ALL 100.05 RECORDS OF A SPECIFIC ORDER
;ORD = 100 IEN
;RET = LIST OF 100.05 IENS
K RET
Q:'$G(ORD)
N RET2
D GETOC2(ORD,.RET)
Q:'$D(RET)
N I S I=0 F S I=$O(RET(ORD,I)) Q:'I D
.D GETOC1(I,.RET2)
.I '$D(RET(ORD,"OI")) M RET(ORD,"OI")=RET2(I,"OI")
.K RET2(I,"OI")
.M RET(ORD,"DATA")=RET2
Q
GETOC5(ORD,OCC,RET) ;GET DATA FOR ALL 100.05 RECORDS OF A SPECIFIC ORDER/OCCURANCE PAIR
;ORD = 100 IEN
;OCC = OCCURANCE STRING
;RET = LIST OF 100.05 IENS WITH DATA
K RET
Q:'$G(ORD)
Q:'$L(OCC)
N RET2
D GETOC3(ORD,OCC,.RET)
Q:'$D(RET)
N I S I=0 F S I=$O(RET(ORD,I)) Q:'I D
.D GETOC1(I,.RET2)
.I '$D(RET(ORD,"OI")) M RET(ORD,"OI")=RET2(I,"OI")
.K RET2(I,"OI")
.M RET(ORD,"DATA")=RET2
Q
CONVERT ;CONVERT EXISTING FILE 100 NODE 9 ENTRIES OVER TO FILE 100.05
N I,J,ORK,DESC
S I=0
I $G(^XTMP("ORK FILE CONVERSION")) S I=+^XTMP("ORK FILE CONVERSION")
F S I=$O(^OR(100,I)) Q:'I I $D(^OR(100,I,9)) I '$D(^ORD(100.05,"B",I)) D CONVERT1(I)
S I=0
F S I=$O(^XTMP("ORK FILE CONVERSION","ERRORS",I)) Q:'I D DELETE(I)
K ^XTMP("ORK FILE CONVERSION","LAST ERRORS")
M ^XTMP("ORK FILE CONVERSION","LAST ERRORS")=^XTMP("ORK FILE CONVERSION","ERRORS")
K ^XTMP("ORK FILE CONVERSION","ERRORS")
S ^XTMP("ORK FILE CONVERSION")=0
D MAIL
Q
CONVERT1(I) ;CONVERT EXISTING FILE 100 NODE 9 ENTRIES OVER TO FILE 100.05 FOR 1 ORDER
N $ETRAP,$ESTACK
S $ETRAP="D ERR^OROCAPI1 Q"
N J,ORK,DESC,RET
S DESC="SIGNATURE_CPRS"
S ^XTMP("ORK FILE CONVERSION",0)=$$FMADD^XLFDT($$NOW^XLFDT,90)_U_$$NOW^XLFDT
I ",11,13,14,"[(","_$P($G(^OR(100,I,3)),U,3)_",") S DESC="ACCEPTANCE_CPRS"
S J=0 F S J=$O(^OR(100,I,9,J)) Q:'J D
.N X0,X1 S X0=$G(^OR(100,I,9,J,0)),X1=$G(^OR(100,I,9,J,1))
.N ORKDT S ORKDT=$S($P(X0,U,6):$P(X0,U,6),1:$P($G(^OR(100,I,0)),U,7))
.S ORK(J,1)=I_U_DESC_U_$P(X0,U,5)_U_ORKDT_U_$P(X0,U)
.S ORK(J,2)=X1
.S ORK(J,3)=$P(X0,U,4)
I $D(ORK) D SAVEOC^OROCAPI1(.ORK,.RET)
S ^XTMP("ORK FILE CONVERSION")=I
Q
COPY(ORD1,ORD2) ;COPY THE ORDER CHECKS FROM ORDER 1 TO ORDER 2
N RET,I,DIC,DIK
D GETOC2(ORD1,.RET)
S DIC="^ORD(100.05,",DIC(0)="F",DIK=DIC
S I=0 F S I=$O(RET(ORD1,I)) Q:+$G(I)=0 D
.;CREATE THE NEW ENTRY
.N X,DO,Y,DTOUT,DUOUT,DA
.S X=ORD2 D FILE^DICN
.Q:'DA
.;COPY EXISTING DATA
.K ^TMP($J,"OROCAPI1")
.M ^TMP($J,"OROCAPI1")=^ORD(100.05,I)
.S $P(^TMP($J,"OROCAPI1",0),U,1)=ORD2
.M ^ORD(100.05,DA)=^TMP($J,"OROCAPI1")
.;UPDATE CROSS-REFERENCES
.D IX1^DIK
K ^TMP($J,"OROCAPI1")
Q
OCCNT(ORD) ;RETURN 1 IF THERE ARE ORDER CHECKS AND 0 IF NOT
N RET,Y D GETOC2(ORD,.RET)
S Y=0 I $D(RET) S Y=1
Q Y
DELETE(ORD) ;DELETE ALL OF THE OC INSTANCES FOR AN ORDER
N RET,I,DIK,DA D GETOC2(ORD,.RET)
S I=0 F S I=$O(RET(ORD,I)) Q:'I S DA=I,DIK="^ORD(100.05," D ^DIK
Q
DELOCC(ORD,OCC) ;DELETE ALL OF THE OC INSTANCES FOR AN ORDER/OCCURANCE PAIR
N RET,I,DIK,DA D GETOC3(ORD,OCC,.RET)
S I=0 F S I=$O(RET(ORD,I)) Q:'I S DA=I,DIK="^ORD(100.05," D ^DIK
Q
ERR ;
S ^XTMP("ORK FILE CONVERSION","ERRORS",ORN)=""
S ^XTMP("ORK FILE CONVERSION")=ORN
D UNWIND^%ZTER
Q
MAIL ;send mail message to installer if any errors encountered during conversion process
Q:'$D(^XTMP("ORK FILE CONVERSION","LAST ERRORS"))
N XMSUB,XMTEXT,XMDUZ,XMY,XMZ,XMMG,ORTXT,I,J
S XMDUZ="PATCH OR*3*293 ORDER CHECK CONVERSION" S:$G(DUZ) XMY(^XTMP("ORK FILE CONVERSION","INSTALLER"))=""
S I=0,I=I+1,^TMP($J,"ORTXT",I)=""
S I=I+1,^TMP($J,"ORTXT",I)="While converting order check information from file 100 node 9 over to file"
S I=I+1,^TMP($J,"ORTXT",I)="100.05, data errors were discovered for the order numbers listed below."
S I=I+1,^TMP($J,"ORTXT",I)="All other order data converted appropriately."
S I=I+1,^TMP($J,"ORTXT",I)="We recommend correcting the data, and then re-running the"
S I=I+1,^TMP($J,"ORTXT",I)="conversion utility from programmer prompt as follows:"
S I=I+1,^TMP($J,"ORTXT",I)=" D CONVERT^OROCAPI1"
S I=I+1,^TMP($J,"ORTXT",I)="NOTE: re-running the conversion utility will only convert those orders that"
S I=I+1,^TMP($J,"ORTXT",I)="did not convert properly the first time."
S I=I+1,^TMP($J,"ORTXT",I)=""
S I=I+1,^TMP($J,"ORTXT",I)="LIST OF ORDERS WITH CORRUPTED ORDER CHECK DATA"
S I=I+1,^TMP($J,"ORTXT",I)="=============================================="
S J=0 F S J=$O(^XTMP("ORK FILE CONVERSION","LAST ERRORS",J)) Q:'J S I=I+1,^TMP($J,"ORTXT",I)=J
S XMTEXT="^TMP($J,""ORTXT"",",XMSUB="PATCH OR*3*293 CONVERSION ERRORS!"
D ^XMD
Q
REMOTE ;Get remote allergy comment ;TDP
N X
S X=0 F S X=$O(^ORD(100.05,IEN,4,X)) Q:+X=0 D
. I $G(^ORD(100.05,IEN,4,X,4))="" Q
. S RET(IEN,"CM")=$G(^ORD(100.05,IEN,4,X,4))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOROCAPI1 8760 printed Nov 22, 2024@17:42:15 Page 2
OROCAPI1 ;SLC/JMH - ORDER CHECK INSTANCES FILE APIS; 02/04/2015 12:18 ;05/17/17 09:34
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**293,346,345,269,405**;Dec 17, 1997;Build 211
SAVEOC(ORL,RET) ;SAVE A GROUP OF ORDER CHECKS
+1 ;ORL=LIST OF ORDER CHECKS
+2 ;(D0,1)=ORDER NUMBER (FILE 100)^
+3 ; OCCURANCE DESCRIPTOR^
+4 ; USER (FILE 200)^
+5 ; OCCURANCE D/T^
+6 ; ORDER CHECK NUMBER (FILE 100.8)^
+7 ; CLINICAL DANGER LEVEL
+8 ; (D0,2,D1)=ORDER CHECK NARRATIVE
+9 ; (D0,3)=OVERRIDE REASON
+10 ; (D0,4)=COMMENT FOR A REMOTE ALLERGY
+11 ;RET=RETURN ARRAY OF IENS BY ORL(D0)
+12 ; RET(D0,IEN)=""
+13 NEW I
SET I=0
FOR
SET I=$ORDER(ORL(I))
if 'I
QUIT
Begin DoDot:1
+14 NEW DA,DR,DIC,X,Y,DIE,ORSTATUS,ORN,ORDANG,DW,DV,%,D,DC,DE,DH,DI,DIEL,DIFLD,DIP,DK,DM,DP,DQ,ORKMSG,DTOUT
+15 NEW ORFDART,ORIENRT,ORMSGRT,J,ERROR,IEN
+16 SET ORN=+ORL(I,1)
+17 if 'ORN!('$DATA(^OR(100,ORN)))
QUIT
+18 ;QUIT IF NO ORDER CHECK NUMBER
if '$PIECE(ORL(I,1),U,5)
QUIT
+19 ;QUIT IF NO ORDER CHECK TEXT
if '$DATA(ORL(I,2))
QUIT
+20 IF $GET(FLDS("ORDUZ"))]""
SET $PIECE(ORL(I,1),"^",3)=$GET(FLDS("ORDUZ"))
+21 KILL ^TMP("DIERR",$JOB)
+22 SET ORFDART(100.05,"+1,",.01)=ORN
+23 DO UPDATE^DIE("","ORFDART","ORIENRT","ORMSGRT")
+24 IF $DATA(ORIENRT(1))
SET DA=ORIENRT(1)
+25 if '$GET(DA)
QUIT
+26 SET RET(I,DA)=""
+27 SET DIC="^ORD(100.05,"
SET DIC(0)="F"
SET X=ORN
+28 SET DIE=DIC
SET ORSTATUS=$PIECE($GET(^OR(100,ORN,3)),U,3)
SET ORDANG=$SELECT($PIECE($GET(ORL(I,1)),U,6):$PIECE($GET(ORL(I,1)),U,6),1:$$GET^XPAR("ALL","ORK CLINICAL DANGER LEVEL",$PIECE($GET(ORL(I,1)),U,5),"I"))
+29 SET DR="1////"_ORSTATUS_";2////"_$PIECE($GET(ORL(I,1)),U,2)_";3////"_$PIECE($GET(ORL(I,1)),U,3)_";4////"_$PIECE($GET(ORL(I,1)),U,4)_";5////"_$PIECE($GET(ORL(I,1)),U,5)_";6////"_ORDANG_";7///"_$TRANSLATE($GET(ORL(I,3)),";",",")
+30 DO ^DIE
+31 DO WP^DIE(100.05,DA_",",8,,"ORL("_I_",2)","ERROR")
+32 SET J=0
FOR
SET J=$ORDER(ORL(I,2,J))
if 'J
QUIT
SET ORKMSG=$GET(ORKMSG)_ORL(I,2,J)
+33 ;SAVE ALLERGY DATA IF IT EXISTS
+34 NEW CRC16,ORDA
+35 SET CRC16=$$CRC16^XLFCRC(ORKMSG)
SET ORDA=DA
+36 IF $DATA(^TMP("OROCIDATA",$JOB,CRC16))
Begin DoDot:2
+37 NEW FDA,CLASS,ING,SIGN,ERROR,NUM
+38 SET FDA(100.05,ORDA_",",84)=$GET(^TMP("OROCIDATA",$JOB,CRC16,100.05,84))
+39 DO FILE^DIE("K","FDA","ERROR")
+40 SET NUM=0
FOR
SET NUM=$ORDER(^TMP("OROCIDATA",$JOB,CRC16,100.517,NUM))
if 'NUM
QUIT
Begin DoDot:3
+41 IF $GET(ORL(I,4))]""
SET ^TMP("OROCIDATA",$JOB,CRC16,100.517,NUM,11)=ORL(I,4)
+42 MERGE FDA(100.517,"+1,"_ORDA_",")=^TMP("OROCIDATA",$JOB,CRC16,100.517,NUM)
+43 if $DATA(FDA)
DO UPDATE^DIE(,"FDA","IEN","ERROR")
+44 SET CLASS=""
FOR
SET CLASS=$ORDER(^TMP("OROCIDATA",$JOB,CRC16,"CLASS",NUM,CLASS))
if $GET(CLASS)=""
QUIT
Begin DoDot:4
+45 SET FDA(100.5173,CLASS_IEN(1)_","_ORDA_",",.01)=^TMP("OROCIDATA",$JOB,CRC16,"CLASS",NUM,CLASS)
End DoDot:4
+46 SET ING=""
FOR
SET ING=$ORDER(^TMP("OROCIDATA",$JOB,CRC16,"INGREDIENT",NUM,ING))
if $GET(ING)=""
QUIT
Begin DoDot:4
+47 SET FDA(100.5174,ING_IEN(1)_","_ORDA_",",.01)=^TMP("OROCIDATA",$JOB,CRC16,"INGREDIENT",NUM,ING)
End DoDot:4
+48 SET SIGN=""
FOR
SET SIGN=$ORDER(^TMP("OROCIDATA",$JOB,CRC16,"SIGN",NUM,SIGN))
if $GET(SIGN)=""
QUIT
Begin DoDot:4
+49 SET FDA(100.5175,SIGN_IEN(1)_","_ORDA_",",.01)=^TMP("OROCIDATA",$JOB,CRC16,"SIGN",NUM,SIGN)
End DoDot:4
+50 if $DATA(FDA)
DO UPDATE^DIE(,"FDA",,"ERROR")
+51 KILL FDA,IEN
End DoDot:3
+52 KILL ^TMP("OROCIDATA",$JOB,CRC16)
End DoDot:2
End DoDot:1
+53 QUIT
GETOC1(IEN,RET) ;GET A SINGLE ORDER CHECK
+1 ;IEN = 100.05 IEN
+2 ;RET = RETURNED 100.05 DATA FOR IEN
+3 KILL RET
+4 if '$GET(IEN)
QUIT
+5 if '$DATA(^ORD(100.05,IEN))
QUIT
+6 SET RET(IEN,0)=$GET(^ORD(100.05,IEN,0))
+7 SET RET(IEN,1)=$GET(^ORD(100.05,IEN,1))
+8 SET $PIECE(RET(IEN,1),U,1)=$PIECE(^ORD(100.8,$PIECE(RET(IEN,1),U,1),0),U,1)_";"_$PIECE(RET(IEN,1),U,1)
+9 MERGE RET(IEN,"OC")=^ORD(100.05,IEN,2)
+10 KILL RET(IEN,"OC",0)
+11 MERGE RET(IEN,"OR")=^ORD(100.05,IEN,3)
+12 KILL RET(IEN,"OR",0)
+13 ;TDP
DO REMOTE
+14 MERGE RET(IEN,"OI")=^OR(100,$PIECE(RET(IEN,0),U,1),.1)
+15 NEW OIEN
+16 SET OIEN=""
FOR
SET OIEN=$ORDER(RET(IEN,"OI",OIEN))
if $GET(OIEN)=""
QUIT
Begin DoDot:1
+17 IF +OIEN=0
KILL RET(IEN,"OI",OIEN)
QUIT
+18 SET RET(IEN,"OI",OIEN,0)=$PIECE(^ORD(101.43,RET(IEN,"OI",OIEN,0),0),U,1,2)
End DoDot:1
+19 QUIT
GETOC2(ORD,RET) ;GET ALL 100.05 IENS FOR A SPECIFIC ORDER
+1 ;ORD = 100 IEN
+2 ;RET = LIST OF 100.05 IENS
+3 KILL RET
+4 if '$GET(ORD)
QUIT
+5 NEW I
SET I=0
FOR
SET I=$ORDER(^ORD(100.05,"B",ORD,I))
if 'I
QUIT
SET RET(ORD,I)=""
+6 QUIT
GETOC3(ORD,OCC,RET) ;GET ALL 100.05 IENS FOR A SPECIFIC ORDER/OCCURANCE PAIR
+1 ;ORD = 100 IEN
+2 ;OCC = OCCURANCE STRING
+3 ;RET = LIST OF 100.05 IENS
+4 KILL RET
+5 if '$GET(ORD)
QUIT
+6 if '$LENGTH(OCC)
QUIT
+7 NEW I
SET I=0
FOR
SET I=$ORDER(^ORD(100.05,"C",ORD,OCC,I))
if 'I
QUIT
SET RET(ORD,I)=""
+8 QUIT
GETOC4(ORD,RET) ;GET DATA FOR ALL 100.05 RECORDS OF A SPECIFIC ORDER
+1 ;ORD = 100 IEN
+2 ;RET = LIST OF 100.05 IENS
+3 KILL RET
+4 if '$GET(ORD)
QUIT
+5 NEW RET2
+6 DO GETOC2(ORD,.RET)
+7 if '$DATA(RET)
QUIT
+8 NEW I
SET I=0
FOR
SET I=$ORDER(RET(ORD,I))
if 'I
QUIT
Begin DoDot:1
+9 DO GETOC1(I,.RET2)
+10 IF '$DATA(RET(ORD,"OI"))
MERGE RET(ORD,"OI")=RET2(I,"OI")
+11 KILL RET2(I,"OI")
+12 MERGE RET(ORD,"DATA")=RET2
End DoDot:1
+13 QUIT
GETOC5(ORD,OCC,RET) ;GET DATA FOR ALL 100.05 RECORDS OF A SPECIFIC ORDER/OCCURANCE PAIR
+1 ;ORD = 100 IEN
+2 ;OCC = OCCURANCE STRING
+3 ;RET = LIST OF 100.05 IENS WITH DATA
+4 KILL RET
+5 if '$GET(ORD)
QUIT
+6 if '$LENGTH(OCC)
QUIT
+7 NEW RET2
+8 DO GETOC3(ORD,OCC,.RET)
+9 if '$DATA(RET)
QUIT
+10 NEW I
SET I=0
FOR
SET I=$ORDER(RET(ORD,I))
if 'I
QUIT
Begin DoDot:1
+11 DO GETOC1(I,.RET2)
+12 IF '$DATA(RET(ORD,"OI"))
MERGE RET(ORD,"OI")=RET2(I,"OI")
+13 KILL RET2(I,"OI")
+14 MERGE RET(ORD,"DATA")=RET2
End DoDot:1
+15 QUIT
CONVERT ;CONVERT EXISTING FILE 100 NODE 9 ENTRIES OVER TO FILE 100.05
+1 NEW I,J,ORK,DESC
+2 SET I=0
+3 IF $GET(^XTMP("ORK FILE CONVERSION"))
SET I=+^XTMP("ORK FILE CONVERSION")
+4 FOR
SET I=$ORDER(^OR(100,I))
if 'I
QUIT
IF $DATA(^OR(100,I,9))
IF '$DATA(^ORD(100.05,"B",I))
DO CONVERT1(I)
+5 SET I=0
+6 FOR
SET I=$ORDER(^XTMP("ORK FILE CONVERSION","ERRORS",I))
if 'I
QUIT
DO DELETE(I)
+7 KILL ^XTMP("ORK FILE CONVERSION","LAST ERRORS")
+8 MERGE ^XTMP("ORK FILE CONVERSION","LAST ERRORS")=^XTMP("ORK FILE CONVERSION","ERRORS")
+9 KILL ^XTMP("ORK FILE CONVERSION","ERRORS")
+10 SET ^XTMP("ORK FILE CONVERSION")=0
+11 DO MAIL
+12 QUIT
CONVERT1(I) ;CONVERT EXISTING FILE 100 NODE 9 ENTRIES OVER TO FILE 100.05 FOR 1 ORDER
+1 NEW $ETRAP,$ESTACK
+2 SET $ETRAP="D ERR^OROCAPI1 Q"
+3 NEW J,ORK,DESC,RET
+4 SET DESC="SIGNATURE_CPRS"
+5 SET ^XTMP("ORK FILE CONVERSION",0)=$$FMADD^XLFDT($$NOW^XLFDT,90)_U_$$NOW^XLFDT
+6 IF ",11,13,14,"[(","_$PIECE($GET(^OR(100,I,3)),U,3)_",")
SET DESC="ACCEPTANCE_CPRS"
+7 SET J=0
FOR
SET J=$ORDER(^OR(100,I,9,J))
if 'J
QUIT
Begin DoDot:1
+8 NEW X0,X1
SET X0=$GET(^OR(100,I,9,J,0))
SET X1=$GET(^OR(100,I,9,J,1))
+9 NEW ORKDT
SET ORKDT=$SELECT($PIECE(X0,U,6):$PIECE(X0,U,6),1:$PIECE($GET(^OR(100,I,0)),U,7))
+10 SET ORK(J,1)=I_U_DESC_U_$PIECE(X0,U,5)_U_ORKDT_U_$PIECE(X0,U)
+11 SET ORK(J,2)=X1
+12 SET ORK(J,3)=$PIECE(X0,U,4)
End DoDot:1
+13 IF $DATA(ORK)
DO SAVEOC^OROCAPI1(.ORK,.RET)
+14 SET ^XTMP("ORK FILE CONVERSION")=I
+15 QUIT
COPY(ORD1,ORD2) ;COPY THE ORDER CHECKS FROM ORDER 1 TO ORDER 2
+1 NEW RET,I,DIC,DIK
+2 DO GETOC2(ORD1,.RET)
+3 SET DIC="^ORD(100.05,"
SET DIC(0)="F"
SET DIK=DIC
+4 SET I=0
FOR
SET I=$ORDER(RET(ORD1,I))
if +$GET(I)=0
QUIT
Begin DoDot:1
+5 ;CREATE THE NEW ENTRY
+6 NEW X,DO,Y,DTOUT,DUOUT,DA
+7 SET X=ORD2
DO FILE^DICN
+8 if 'DA
QUIT
+9 ;COPY EXISTING DATA
+10 KILL ^TMP($JOB,"OROCAPI1")
+11 MERGE ^TMP($JOB,"OROCAPI1")=^ORD(100.05,I)
+12 SET $PIECE(^TMP($JOB,"OROCAPI1",0),U,1)=ORD2
+13 MERGE ^ORD(100.05,DA)=^TMP($JOB,"OROCAPI1")
+14 ;UPDATE CROSS-REFERENCES
+15 DO IX1^DIK
End DoDot:1
+16 KILL ^TMP($JOB,"OROCAPI1")
+17 QUIT
OCCNT(ORD) ;RETURN 1 IF THERE ARE ORDER CHECKS AND 0 IF NOT
+1 NEW RET,Y
DO GETOC2(ORD,.RET)
+2 SET Y=0
IF $DATA(RET)
SET Y=1
+3 QUIT Y
DELETE(ORD) ;DELETE ALL OF THE OC INSTANCES FOR AN ORDER
+1 NEW RET,I,DIK,DA
DO GETOC2(ORD,.RET)
+2 SET I=0
FOR
SET I=$ORDER(RET(ORD,I))
if 'I
QUIT
SET DA=I
SET DIK="^ORD(100.05,"
DO ^DIK
+3 QUIT
DELOCC(ORD,OCC) ;DELETE ALL OF THE OC INSTANCES FOR AN ORDER/OCCURANCE PAIR
+1 NEW RET,I,DIK,DA
DO GETOC3(ORD,OCC,.RET)
+2 SET I=0
FOR
SET I=$ORDER(RET(ORD,I))
if 'I
QUIT
SET DA=I
SET DIK="^ORD(100.05,"
DO ^DIK
+3 QUIT
ERR ;
+1 SET ^XTMP("ORK FILE CONVERSION","ERRORS",ORN)=""
+2 SET ^XTMP("ORK FILE CONVERSION")=ORN
+3 DO UNWIND^%ZTER
+4 QUIT
MAIL ;send mail message to installer if any errors encountered during conversion process
+1 if '$DATA(^XTMP("ORK FILE CONVERSION","LAST ERRORS"))
QUIT
+2 NEW XMSUB,XMTEXT,XMDUZ,XMY,XMZ,XMMG,ORTXT,I,J
+3 SET XMDUZ="PATCH OR*3*293 ORDER CHECK CONVERSION"
if $GET(DUZ)
SET XMY(^XTMP("ORK FILE CONVERSION","INSTALLER"))=""
+4 SET I=0
SET I=I+1
SET ^TMP($JOB,"ORTXT",I)=""
+5 SET I=I+1
SET ^TMP($JOB,"ORTXT",I)="While converting order check information from file 100 node 9 over to file"
+6 SET I=I+1
SET ^TMP($JOB,"ORTXT",I)="100.05, data errors were discovered for the order numbers listed below."
+7 SET I=I+1
SET ^TMP($JOB,"ORTXT",I)="All other order data converted appropriately."
+8 SET I=I+1
SET ^TMP($JOB,"ORTXT",I)="We recommend correcting the data, and then re-running the"
+9 SET I=I+1
SET ^TMP($JOB,"ORTXT",I)="conversion utility from programmer prompt as follows:"
+10 SET I=I+1
SET ^TMP($JOB,"ORTXT",I)=" D CONVERT^OROCAPI1"
+11 SET I=I+1
SET ^TMP($JOB,"ORTXT",I)="NOTE: re-running the conversion utility will only convert those orders that"
+12 SET I=I+1
SET ^TMP($JOB,"ORTXT",I)="did not convert properly the first time."
+13 SET I=I+1
SET ^TMP($JOB,"ORTXT",I)=""
+14 SET I=I+1
SET ^TMP($JOB,"ORTXT",I)="LIST OF ORDERS WITH CORRUPTED ORDER CHECK DATA"
+15 SET I=I+1
SET ^TMP($JOB,"ORTXT",I)="=============================================="
+16 SET J=0
FOR
SET J=$ORDER(^XTMP("ORK FILE CONVERSION","LAST ERRORS",J))
if 'J
QUIT
SET I=I+1
SET ^TMP($JOB,"ORTXT",I)=J
+17 SET XMTEXT="^TMP($J,""ORTXT"","
SET XMSUB="PATCH OR*3*293 CONVERSION ERRORS!"
+18 DO ^XMD
+19 QUIT
REMOTE ;Get remote allergy comment ;TDP
+1 NEW X
+2 SET X=0
FOR
SET X=$ORDER(^ORD(100.05,IEN,4,X))
if +X=0
QUIT
Begin DoDot:1
+3 IF $GET(^ORD(100.05,IEN,4,X,4))=""
QUIT
+4 SET RET(IEN,"CM")=$GET(^ORD(100.05,IEN,4,X,4))
End DoDot:1
+5 QUIT
