Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: OROCAPI1

OROCAPI1.m

Go to the documentation of this file.
  1. 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
  1. SAVEOC(ORL,RET) ;SAVE A GROUP OF ORDER CHECKS
  1. ;ORL=LIST OF ORDER CHECKS
  1. ;(D0,1)=ORDER NUMBER (FILE 100)^
  1. ; OCCURANCE DESCRIPTOR^
  1. ; USER (FILE 200)^
  1. ; OCCURANCE D/T^
  1. ; ORDER CHECK NUMBER (FILE 100.8)^
  1. ; CLINICAL DANGER LEVEL
  1. ; (D0,2,D1)=ORDER CHECK NARRATIVE
  1. ; (D0,3)=OVERRIDE REASON
  1. ; (D0,4)=COMMENT FOR A REMOTE ALLERGY
  1. ;RET=RETURN ARRAY OF IENS BY ORL(D0)
  1. ; RET(D0,IEN)=""
  1. N I S I=0 F S I=$O(ORL(I)) Q:'I D
  1. .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
  1. .N ORFDART,ORIENRT,ORMSGRT,J,ERROR,IEN
  1. .S ORN=+ORL(I,1)
  1. .Q:'ORN!('$D(^OR(100,ORN)))
  1. .Q:'$P(ORL(I,1),U,5) ;QUIT IF NO ORDER CHECK NUMBER
  1. .Q:'$D(ORL(I,2)) ;QUIT IF NO ORDER CHECK TEXT
  1. .I $G(FLDS("ORDUZ"))]"" S $P(ORL(I,1),"^",3)=$G(FLDS("ORDUZ"))
  1. .K ^TMP("DIERR",$J)
  1. .S ORFDART(100.05,"+1,",.01)=ORN
  1. .D UPDATE^DIE("","ORFDART","ORIENRT","ORMSGRT")
  1. .I $D(ORIENRT(1)) S DA=ORIENRT(1)
  1. .Q:'$G(DA)
  1. .S RET(I,DA)=""
  1. .S DIC="^ORD(100.05,",DIC(0)="F",X=ORN
  1. .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"))
  1. .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)),";",",")
  1. .D ^DIE
  1. .D WP^DIE(100.05,DA_",",8,,"ORL("_I_",2)","ERROR")
  1. .S J=0 F S J=$O(ORL(I,2,J)) Q:'J S ORKMSG=$G(ORKMSG)_ORL(I,2,J)
  1. .;SAVE ALLERGY DATA IF IT EXISTS
  1. .N CRC16,ORDA
  1. .S CRC16=$$CRC16^XLFCRC(ORKMSG),ORDA=DA
  1. .I $D(^TMP("OROCIDATA",$J,CRC16)) D
  1. ..N FDA,CLASS,ING,SIGN,ERROR,NUM
  1. ..S FDA(100.05,ORDA_",",84)=$G(^TMP("OROCIDATA",$J,CRC16,100.05,84))
  1. ..D FILE^DIE("K","FDA","ERROR")
  1. ..S NUM=0 F S NUM=$O(^TMP("OROCIDATA",$J,CRC16,100.517,NUM)) Q:'NUM D
  1. ...I $G(ORL(I,4))]"" S ^TMP("OROCIDATA",$J,CRC16,100.517,NUM,11)=ORL(I,4)
  1. ...M FDA(100.517,"+1,"_ORDA_",")=^TMP("OROCIDATA",$J,CRC16,100.517,NUM)
  1. ...D:$D(FDA) UPDATE^DIE(,"FDA","IEN","ERROR")
  1. ...S CLASS="" F S CLASS=$O(^TMP("OROCIDATA",$J,CRC16,"CLASS",NUM,CLASS)) Q:$G(CLASS)="" D
  1. ....S FDA(100.5173,CLASS_IEN(1)_","_ORDA_",",.01)=^TMP("OROCIDATA",$J,CRC16,"CLASS",NUM,CLASS)
  1. ...S ING="" F S ING=$O(^TMP("OROCIDATA",$J,CRC16,"INGREDIENT",NUM,ING)) Q:$G(ING)="" D
  1. ....S FDA(100.5174,ING_IEN(1)_","_ORDA_",",.01)=^TMP("OROCIDATA",$J,CRC16,"INGREDIENT",NUM,ING)
  1. ...S SIGN="" F S SIGN=$O(^TMP("OROCIDATA",$J,CRC16,"SIGN",NUM,SIGN)) Q:$G(SIGN)="" D
  1. ....S FDA(100.5175,SIGN_IEN(1)_","_ORDA_",",.01)=^TMP("OROCIDATA",$J,CRC16,"SIGN",NUM,SIGN)
  1. ...D:$D(FDA) UPDATE^DIE(,"FDA",,"ERROR")
  1. ...K FDA,IEN
  1. ..K ^TMP("OROCIDATA",$J,CRC16)
  1. Q
  1. GETOC1(IEN,RET) ;GET A SINGLE ORDER CHECK
  1. ;IEN = 100.05 IEN
  1. ;RET = RETURNED 100.05 DATA FOR IEN
  1. K RET
  1. Q:'$G(IEN)
  1. Q:'$D(^ORD(100.05,IEN))
  1. S RET(IEN,0)=$G(^ORD(100.05,IEN,0))
  1. S RET(IEN,1)=$G(^ORD(100.05,IEN,1))
  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)
  1. M RET(IEN,"OC")=^ORD(100.05,IEN,2)
  1. K RET(IEN,"OC",0)
  1. M RET(IEN,"OR")=^ORD(100.05,IEN,3)
  1. K RET(IEN,"OR",0)
  1. D REMOTE ;TDP
  1. M RET(IEN,"OI")=^OR(100,$P(RET(IEN,0),U,1),.1)
  1. N OIEN
  1. S OIEN="" F S OIEN=$O(RET(IEN,"OI",OIEN)) Q:$G(OIEN)="" D
  1. .I +OIEN=0 K RET(IEN,"OI",OIEN) Q
  1. .S RET(IEN,"OI",OIEN,0)=$P(^ORD(101.43,RET(IEN,"OI",OIEN,0),0),U,1,2)
  1. Q
  1. GETOC2(ORD,RET) ;GET ALL 100.05 IENS FOR A SPECIFIC ORDER
  1. ;ORD = 100 IEN
  1. ;RET = LIST OF 100.05 IENS
  1. K RET
  1. Q:'$G(ORD)
  1. N I S I=0 F S I=$O(^ORD(100.05,"B",ORD,I)) Q:'I S RET(ORD,I)=""
  1. Q
  1. GETOC3(ORD,OCC,RET) ;GET ALL 100.05 IENS FOR A SPECIFIC ORDER/OCCURANCE PAIR
  1. ;ORD = 100 IEN
  1. ;OCC = OCCURANCE STRING
  1. ;RET = LIST OF 100.05 IENS
  1. K RET
  1. Q:'$G(ORD)
  1. Q:'$L(OCC)
  1. N I S I=0 F S I=$O(^ORD(100.05,"C",ORD,OCC,I)) Q:'I S RET(ORD,I)=""
  1. Q
  1. GETOC4(ORD,RET) ;GET DATA FOR ALL 100.05 RECORDS OF A SPECIFIC ORDER
  1. ;ORD = 100 IEN
  1. ;RET = LIST OF 100.05 IENS
  1. K RET
  1. Q:'$G(ORD)
  1. N RET2
  1. D GETOC2(ORD,.RET)
  1. Q:'$D(RET)
  1. N I S I=0 F S I=$O(RET(ORD,I)) Q:'I D
  1. .D GETOC1(I,.RET2)
  1. .I '$D(RET(ORD,"OI")) M RET(ORD,"OI")=RET2(I,"OI")
  1. .K RET2(I,"OI")
  1. .M RET(ORD,"DATA")=RET2
  1. Q
  1. GETOC5(ORD,OCC,RET) ;GET DATA FOR ALL 100.05 RECORDS OF A SPECIFIC ORDER/OCCURANCE PAIR
  1. ;ORD = 100 IEN
  1. ;OCC = OCCURANCE STRING
  1. ;RET = LIST OF 100.05 IENS WITH DATA
  1. K RET
  1. Q:'$G(ORD)
  1. Q:'$L(OCC)
  1. N RET2
  1. D GETOC3(ORD,OCC,.RET)
  1. Q:'$D(RET)
  1. N I S I=0 F S I=$O(RET(ORD,I)) Q:'I D
  1. .D GETOC1(I,.RET2)
  1. .I '$D(RET(ORD,"OI")) M RET(ORD,"OI")=RET2(I,"OI")
  1. .K RET2(I,"OI")
  1. .M RET(ORD,"DATA")=RET2
  1. Q
  1. CONVERT ;CONVERT EXISTING FILE 100 NODE 9 ENTRIES OVER TO FILE 100.05
  1. N I,J,ORK,DESC
  1. S I=0
  1. I $G(^XTMP("ORK FILE CONVERSION")) S I=+^XTMP("ORK FILE CONVERSION")
  1. 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)
  1. S I=0
  1. F S I=$O(^XTMP("ORK FILE CONVERSION","ERRORS",I)) Q:'I D DELETE(I)
  1. K ^XTMP("ORK FILE CONVERSION","LAST ERRORS")
  1. M ^XTMP("ORK FILE CONVERSION","LAST ERRORS")=^XTMP("ORK FILE CONVERSION","ERRORS")
  1. K ^XTMP("ORK FILE CONVERSION","ERRORS")
  1. S ^XTMP("ORK FILE CONVERSION")=0
  1. D MAIL
  1. Q
  1. CONVERT1(I) ;CONVERT EXISTING FILE 100 NODE 9 ENTRIES OVER TO FILE 100.05 FOR 1 ORDER
  1. N $ETRAP,$ESTACK
  1. S $ETRAP="D ERR^OROCAPI1 Q"
  1. N J,ORK,DESC,RET
  1. S DESC="SIGNATURE_CPRS"
  1. S ^XTMP("ORK FILE CONVERSION",0)=$$FMADD^XLFDT($$NOW^XLFDT,90)_U_$$NOW^XLFDT
  1. I ",11,13,14,"[(","_$P($G(^OR(100,I,3)),U,3)_",") S DESC="ACCEPTANCE_CPRS"
  1. S J=0 F S J=$O(^OR(100,I,9,J)) Q:'J D
  1. .N X0,X1 S X0=$G(^OR(100,I,9,J,0)),X1=$G(^OR(100,I,9,J,1))
  1. .N ORKDT S ORKDT=$S($P(X0,U,6):$P(X0,U,6),1:$P($G(^OR(100,I,0)),U,7))
  1. .S ORK(J,1)=I_U_DESC_U_$P(X0,U,5)_U_ORKDT_U_$P(X0,U)
  1. .S ORK(J,2)=X1
  1. .S ORK(J,3)=$P(X0,U,4)
  1. I $D(ORK) D SAVEOC^OROCAPI1(.ORK,.RET)
  1. S ^XTMP("ORK FILE CONVERSION")=I
  1. Q
  1. COPY(ORD1,ORD2) ;COPY THE ORDER CHECKS FROM ORDER 1 TO ORDER 2
  1. N RET,I,DIC,DIK
  1. D GETOC2(ORD1,.RET)
  1. S DIC="^ORD(100.05,",DIC(0)="F",DIK=DIC
  1. S I=0 F S I=$O(RET(ORD1,I)) Q:+$G(I)=0 D
  1. .;CREATE THE NEW ENTRY
  1. .N X,DO,Y,DTOUT,DUOUT,DA
  1. .S X=ORD2 D FILE^DICN
  1. .Q:'DA
  1. .;COPY EXISTING DATA
  1. .K ^TMP($J,"OROCAPI1")
  1. .M ^TMP($J,"OROCAPI1")=^ORD(100.05,I)
  1. .S $P(^TMP($J,"OROCAPI1",0),U,1)=ORD2
  1. .M ^ORD(100.05,DA)=^TMP($J,"OROCAPI1")
  1. .;UPDATE CROSS-REFERENCES
  1. .D IX1^DIK
  1. K ^TMP($J,"OROCAPI1")
  1. Q
  1. OCCNT(ORD) ;RETURN 1 IF THERE ARE ORDER CHECKS AND 0 IF NOT
  1. N RET,Y D GETOC2(ORD,.RET)
  1. S Y=0 I $D(RET) S Y=1
  1. Q Y
  1. DELETE(ORD) ;DELETE ALL OF THE OC INSTANCES FOR AN ORDER
  1. N RET,I,DIK,DA D GETOC2(ORD,.RET)
  1. S I=0 F S I=$O(RET(ORD,I)) Q:'I S DA=I,DIK="^ORD(100.05," D ^DIK
  1. Q
  1. DELOCC(ORD,OCC) ;DELETE ALL OF THE OC INSTANCES FOR AN ORDER/OCCURANCE PAIR
  1. N RET,I,DIK,DA D GETOC3(ORD,OCC,.RET)
  1. S I=0 F S I=$O(RET(ORD,I)) Q:'I S DA=I,DIK="^ORD(100.05," D ^DIK
  1. Q
  1. ERR ;
  1. S ^XTMP("ORK FILE CONVERSION","ERRORS",ORN)=""
  1. S ^XTMP("ORK FILE CONVERSION")=ORN
  1. D UNWIND^%ZTER
  1. Q
  1. MAIL ;send mail message to installer if any errors encountered during conversion process
  1. Q:'$D(^XTMP("ORK FILE CONVERSION","LAST ERRORS"))
  1. N XMSUB,XMTEXT,XMDUZ,XMY,XMZ,XMMG,ORTXT,I,J
  1. S XMDUZ="PATCH OR*3*293 ORDER CHECK CONVERSION" S:$G(DUZ) XMY(^XTMP("ORK FILE CONVERSION","INSTALLER"))=""
  1. S I=0,I=I+1,^TMP($J,"ORTXT",I)=""
  1. S I=I+1,^TMP($J,"ORTXT",I)="While converting order check information from file 100 node 9 over to file"
  1. S I=I+1,^TMP($J,"ORTXT",I)="100.05, data errors were discovered for the order numbers listed below."
  1. S I=I+1,^TMP($J,"ORTXT",I)="All other order data converted appropriately."
  1. S I=I+1,^TMP($J,"ORTXT",I)="We recommend correcting the data, and then re-running the"
  1. S I=I+1,^TMP($J,"ORTXT",I)="conversion utility from programmer prompt as follows:"
  1. S I=I+1,^TMP($J,"ORTXT",I)=" D CONVERT^OROCAPI1"
  1. S I=I+1,^TMP($J,"ORTXT",I)="NOTE: re-running the conversion utility will only convert those orders that"
  1. S I=I+1,^TMP($J,"ORTXT",I)="did not convert properly the first time."
  1. S I=I+1,^TMP($J,"ORTXT",I)=""
  1. S I=I+1,^TMP($J,"ORTXT",I)="LIST OF ORDERS WITH CORRUPTED ORDER CHECK DATA"
  1. S I=I+1,^TMP($J,"ORTXT",I)="=============================================="
  1. 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
  1. S XMTEXT="^TMP($J,""ORTXT"",",XMSUB="PATCH OR*3*293 CONVERSION ERRORS!"
  1. D ^XMD
  1. Q
  1. REMOTE ;Get remote allergy comment ;TDP
  1. N X
  1. S X=0 F S X=$O(^ORD(100.05,IEN,4,X)) Q:+X=0 D
  1. . I $G(^ORD(100.05,IEN,4,X,4))="" Q
  1. . S RET(IEN,"CM")=$G(^ORD(100.05,IEN,4,X,4))
  1. Q