- 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 Jan 18, 2025@03:33:27 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