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.
OROCAPI1 ;SLC/JMH - ORDER CHECK INSTANCES FILE APIS; 02/04/2015  12:18
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**293,346,345,269**;Dec 17, 1997;Build 85
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
 ;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
 ...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)
 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