ORY212 ;SLC/MKB - postinit for OR*3*212 ;2/11/08 11:06
;;3.0;ORDER ENTRY/RESULTS REPORTING;**212**;Dec 17, 1997;Build 24
;
PRE ; -- preinit [clean up test accounts]
D DAT
Q
;
DLGSEND(X) ; -- Send order dialog X?
I X="VBEC BLOOD BANK" Q 1
I X="OR GTX AMOUNT" Q 1
I X="OR GTX DATE/TIME" Q 1
I X="OR GTX LAB ORDER" Q 1
I X="OR GTX RBC MODIFIERS" Q 1
I X="OR GTX REASON" Q 1
I X="OR GTX RESULTS" Q 1
I X="OR GTX SPECIMEN STATUS" Q 1
I X="OR GTX TEXT" Q 1
;I X="OR GTX TRANSFUSION" Q 1
Q 0
;
POST ; -- postinit
D DGRP,URG,ORDITMS ;,COMP
D MAIN^ORY212P ;install parameter values [created by ^XPARTPV]
Q
;
DGRP ; -- ck Default Dialog, Members
N VB,ORI,X,Y,DA,DIC,DLAYGO,DO,DD,DR,DIE
S VB=+$O(^ORD(100.98,"B","VBEC",0)) I VB D
. S X=$P($G(^ORD(100.98,VB,0)),U,4) D:X'>0 ;Default Dialog
.. S X=+$O(^ORD(101.41,"B","VBEC BLOOD BANK",0))
.. S:X $P(^ORD(100.98,VB,0),U,4)=X
. S DA(1)=VB,DIE="^ORD(100.98,"_VB_",1," ;Members
. F ORI="1^VBC","2^VBT" D
.. S X=+$G(^ORD(100.98,VB,1,+ORI,0))
.. I $P($G(^ORD(100.98,X,0)),U,3)'=$P(ORI,U,2) S DA=+ORI,DR=".01///"_$P(ORI,U,2) D ^DIE
S DA(1)=$O(^ORD(100.98,"B","BB",0)) Q:'DA(1)
Q:$O(^ORD(100.98,DA(1),1,"B",VB,0)) ;already linked
S:'$D(^ORD(100.98,DA(1),1,0)) ^(0)="^100.981P^^"
S DIC="^ORD(100.98,"_DA(1)_",1,",DIC(0)="NLX",DLAYGO=100.98
S X="BLOOD PRODUCTS" K Y D ^DIC
Q
;
URG ; -- create new PRE-OP urgency, add VBEC usage to STAT,ROUTINE
N HDR,ORI,IEN
I '$O(^ORD(101.42,"B","PRE-OP",0)) D ;add to file [at ien #3]
. S HDR=$G(^ORD(101.42,0)),^(0)=$P(HDR,U,1,3)_U_($P(HDR,U,4)+1),IEN=3
. I $L($G(^ORD(101.42,3,0))) S IEN=$O(^ORD(101.42,90),-1) ;before DONE
. S ^ORD(101.42,IEN,0)="PRE-OP^P",^(1,0)="^101.421A^1^1",^(1,0)="VBEC"
. S ^ORD(101.42,IEN,1,"B","VBEC",1)="",^ORD(101.42,"S.VBEC","PRE-OP",IEN)=""
. S ^ORD(101.42,"B","PRE-OP",IEN)="",^ORD(101.42,"C","P",IEN)=""
F ORI=1,2,9 I '$O(^ORD(101.42,ORI,1,"B","VBEC",0)) D ;add VBEC Usage
. N DA,DIC,X,Y,DLAYGO,DO,DD
. S DA(1)=ORI,DIC="^ORD(101.42,"_ORI_",1,",DIC(0)="LX",DLAYGO=101.421
. S:'$D(^ORD(101.42,ORI,1,0)) ^(0)="^101.421A^^"
. S X="VBEC" K DO,DD D ^DIC
Q
;
ORDITMS ; -- install VBECS orderable items
Q:$D(^ORD(101.43,"S.VBEC")) ;items already exist
N X,Y,DIC,DIE,DR,DLAYGO,DO,DD,DA,ORDG,ORI,ITEM,ORIT,SUB
S ORDG=$O(^ORD(100.98,"B","VBEC",0)) Q:'ORDG
F ORI=1:1 S ITEM=$T(ITEMS+ORI),X=$P(ITEM,";",3) Q:X="ZZZZ" D
. S DIC="^ORD(101.43,",DIC(0)="LX",DLAYGO=101.43
. K DO,DD,Y D FILE^DICN Q:Y'>0 ;error
. S ORIT=ORI_";99VBC",DR="1.1///"_X_";2///^S X=ORIT;5////"_ORDG
. S DA=+Y,DIE=DIC D ^DIE S ORIT=DA
. S X=$P(ITEM,";",4) I $L(X) D ;define sub-types
.. S ^ORD(101.43,DA,"VB")=X,SUB=$S(X:"VBC",1:"VBT")
.. D SET^ORDD43(SUB,DA)
Q
;
ITEMS ;;VBECS orderable;comp^test or T&S
;;TYPE & SCREEN;^2
;;RED BLOOD CELLS;1^
;;FRESH FROZEN PLASMA;1^
;;PLATELETS;1^
;;CRYOPRECIPITATE;1^
;;OTHER;1^
;;ABO/RH;^1
;;ANTIBODY SCREEN;^1
;;DIRECT ANTIGLOBULIN TEST;^1
;;TRANSFUSION REACTION WORKUP;^1
;;WHOLE BLOOD;1^
;;ZZZZ
;
DAT ; -- Strip "(DAT)" from name
N X,DA,DR,DIE
S DA=+$O(^ORD(101.43,"ID","9;99VBC",0))
I DA,$P($G(^ORD(101.43,DA,0)),U)["(" D ;strip "(DAT)"
. S DR=".01///DIRECT ANTIGLOBULIN TEST",DIE="^ORD(101.43,"
. D ^DIE
Q
;
COMP ;Setup package level parameters for OR VBECS COMPONENT ORDER
; [replaced by MAIN^ORY212P in POST]
N ORX,P
S P="OR VBECS COMPONENT ORDER"
D GETLST^XPAR(.ORX,"PKG.ORDER ENTRY/RESULTS REPORTING",P,"Q")
;I $O(ORX(0)) Q ;New parameter has already been setup
D SET("RED BLOOD CELLS",P,5)
D SET("FRESH FROZEN PLASMA",P,10)
D SET("PLATELETS",P,15)
D SET("CRYOPRECIPITATE",P,20)
D SET("WHOLE BLOOD",P,25)
D SET("OTHER",P,30)
Q
;
SET(ONAME,P,S) ;Set the parameter
;ONAME=Report name
;P=Parameter name
;S=Sequence (count)
N DA,ORERR
S DA=0 F S DA=$O(^ORD(101.43,"S.VBC",ONAME,DA)) Q:'DA D
. D EN^XPAR("PKG.ORDER ENTRY/RESULTS REPORTING",P,S,ONAME,.ORERR)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY212 3995 printed Apr 09, 2024@21:25:19 Page 2
ORY212 ;SLC/MKB - postinit for OR*3*212 ;2/11/08 11:06
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**212**;Dec 17, 1997;Build 24
+2 ;
PRE ; -- preinit [clean up test accounts]
+1 DO DAT
+2 QUIT
+3 ;
DLGSEND(X) ; -- Send order dialog X?
+1 IF X="VBEC BLOOD BANK"
QUIT 1
+2 IF X="OR GTX AMOUNT"
QUIT 1
+3 IF X="OR GTX DATE/TIME"
QUIT 1
+4 IF X="OR GTX LAB ORDER"
QUIT 1
+5 IF X="OR GTX RBC MODIFIERS"
QUIT 1
+6 IF X="OR GTX REASON"
QUIT 1
+7 IF X="OR GTX RESULTS"
QUIT 1
+8 IF X="OR GTX SPECIMEN STATUS"
QUIT 1
+9 IF X="OR GTX TEXT"
QUIT 1
+10 ;I X="OR GTX TRANSFUSION" Q 1
+11 QUIT 0
+12 ;
POST ; -- postinit
+1 ;,COMP
DO DGRP
DO URG
DO ORDITMS
+2 ;install parameter values [created by ^XPARTPV]
DO MAIN^ORY212P
+3 QUIT
+4 ;
DGRP ; -- ck Default Dialog, Members
+1 NEW VB,ORI,X,Y,DA,DIC,DLAYGO,DO,DD,DR,DIE
+2 SET VB=+$ORDER(^ORD(100.98,"B","VBEC",0))
IF VB
Begin DoDot:1
+3 ;Default Dialog
SET X=$PIECE($GET(^ORD(100.98,VB,0)),U,4)
if X'>0
Begin DoDot:2
+4 SET X=+$ORDER(^ORD(101.41,"B","VBEC BLOOD BANK",0))
+5 if X
SET $PIECE(^ORD(100.98,VB,0),U,4)=X
End DoDot:2
+6 ;Members
SET DA(1)=VB
SET DIE="^ORD(100.98,"_VB_",1,"
+7 FOR ORI="1^VBC","2^VBT"
Begin DoDot:2
+8 SET X=+$GET(^ORD(100.98,VB,1,+ORI,0))
+9 IF $PIECE($GET(^ORD(100.98,X,0)),U,3)'=$PIECE(ORI,U,2)
SET DA=+ORI
SET DR=".01///"_$PIECE(ORI,U,2)
DO ^DIE
End DoDot:2
End DoDot:1
+10 SET DA(1)=$ORDER(^ORD(100.98,"B","BB",0))
if 'DA(1)
QUIT
+11 ;already linked
if $ORDER(^ORD(100.98,DA(1),1,"B",VB,0))
QUIT
+12 if '$DATA(^ORD(100.98,DA(1),1,0))
SET ^(0)="^100.981P^^"
+13 SET DIC="^ORD(100.98,"_DA(1)_",1,"
SET DIC(0)="NLX"
SET DLAYGO=100.98
+14 SET X="BLOOD PRODUCTS"
KILL Y
DO ^DIC
+15 QUIT
+16 ;
URG ; -- create new PRE-OP urgency, add VBEC usage to STAT,ROUTINE
+1 NEW HDR,ORI,IEN
+2 ;add to file [at ien #3]
IF '$ORDER(^ORD(101.42,"B","PRE-OP",0))
Begin DoDot:1
+3 SET HDR=$GET(^ORD(101.42,0))
SET ^(0)=$PIECE(HDR,U,1,3)_U_($PIECE(HDR,U,4)+1)
SET IEN=3
+4 ;before DONE
IF $LENGTH($GET(^ORD(101.42,3,0)))
SET IEN=$ORDER(^ORD(101.42,90),-1)
+5 SET ^ORD(101.42,IEN,0)="PRE-OP^P"
SET ^(1,0)="^101.421A^1^1"
SET ^(1,0)="VBEC"
+6 SET ^ORD(101.42,IEN,1,"B","VBEC",1)=""
SET ^ORD(101.42,"S.VBEC","PRE-OP",IEN)=""
+7 SET ^ORD(101.42,"B","PRE-OP",IEN)=""
SET ^ORD(101.42,"C","P",IEN)=""
End DoDot:1
+8 ;add VBEC Usage
FOR ORI=1,2,9
IF '$ORDER(^ORD(101.42,ORI,1,"B","VBEC",0))
Begin DoDot:1
+9 NEW DA,DIC,X,Y,DLAYGO,DO,DD
+10 SET DA(1)=ORI
SET DIC="^ORD(101.42,"_ORI_",1,"
SET DIC(0)="LX"
SET DLAYGO=101.421
+11 if '$DATA(^ORD(101.42,ORI,1,0))
SET ^(0)="^101.421A^^"
+12 SET X="VBEC"
KILL DO,DD
DO ^DIC
End DoDot:1
+13 QUIT
+14 ;
ORDITMS ; -- install VBECS orderable items
+1 ;items already exist
if $DATA(^ORD(101.43,"S.VBEC"))
QUIT
+2 NEW X,Y,DIC,DIE,DR,DLAYGO,DO,DD,DA,ORDG,ORI,ITEM,ORIT,SUB
+3 SET ORDG=$ORDER(^ORD(100.98,"B","VBEC",0))
if 'ORDG
QUIT
+4 FOR ORI=1:1
SET ITEM=$TEXT(ITEMS+ORI)
SET X=$PIECE(ITEM,";",3)
if X="ZZZZ"
QUIT
Begin DoDot:1
+5 SET DIC="^ORD(101.43,"
SET DIC(0)="LX"
SET DLAYGO=101.43
+6 ;error
KILL DO,DD,Y
DO FILE^DICN
if Y'>0
QUIT
+7 SET ORIT=ORI_";99VBC"
SET DR="1.1///"_X_";2///^S X=ORIT;5////"_ORDG
+8 SET DA=+Y
SET DIE=DIC
DO ^DIE
SET ORIT=DA
+9 ;define sub-types
SET X=$PIECE(ITEM,";",4)
IF $LENGTH(X)
Begin DoDot:2
+10 SET ^ORD(101.43,DA,"VB")=X
SET SUB=$SELECT(X:"VBC",1:"VBT")
+11 DO SET^ORDD43(SUB,DA)
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
ITEMS ;;VBECS orderable;comp^test or T&S
+1 ;;TYPE & SCREEN;^2
+2 ;;RED BLOOD CELLS;1^
+3 ;;FRESH FROZEN PLASMA;1^
+4 ;;PLATELETS;1^
+5 ;;CRYOPRECIPITATE;1^
+6 ;;OTHER;1^
+7 ;;ABO/RH;^1
+8 ;;ANTIBODY SCREEN;^1
+9 ;;DIRECT ANTIGLOBULIN TEST;^1
+10 ;;TRANSFUSION REACTION WORKUP;^1
+11 ;;WHOLE BLOOD;1^
+12 ;;ZZZZ
+13 ;
DAT ; -- Strip "(DAT)" from name
+1 NEW X,DA,DR,DIE
+2 SET DA=+$ORDER(^ORD(101.43,"ID","9;99VBC",0))
+3 ;strip "(DAT)"
IF DA
IF $PIECE($GET(^ORD(101.43,DA,0)),U)["("
Begin DoDot:1
+4 SET DR=".01///DIRECT ANTIGLOBULIN TEST"
SET DIE="^ORD(101.43,"
+5 DO ^DIE
End DoDot:1
+6 QUIT
+7 ;
COMP ;Setup package level parameters for OR VBECS COMPONENT ORDER
+1 ; [replaced by MAIN^ORY212P in POST]
+2 NEW ORX,P
+3 SET P="OR VBECS COMPONENT ORDER"
+4 DO GETLST^XPAR(.ORX,"PKG.ORDER ENTRY/RESULTS REPORTING",P,"Q")
+5 ;I $O(ORX(0)) Q ;New parameter has already been setup
+6 DO SET("RED BLOOD CELLS",P,5)
+7 DO SET("FRESH FROZEN PLASMA",P,10)
+8 DO SET("PLATELETS",P,15)
+9 DO SET("CRYOPRECIPITATE",P,20)
+10 DO SET("WHOLE BLOOD",P,25)
+11 DO SET("OTHER",P,30)
+12 QUIT
+13 ;
SET(ONAME,P,S) ;Set the parameter
+1 ;ONAME=Report name
+2 ;P=Parameter name
+3 ;S=Sequence (count)
+4 NEW DA,ORERR
+5 SET DA=0
FOR
SET DA=$ORDER(^ORD(101.43,"S.VBC",ONAME,DA))
if 'DA
QUIT
Begin DoDot:1
+6 DO EN^XPAR("PKG.ORDER ENTRY/RESULTS REPORTING",P,S,ONAME,.ORERR)
End DoDot:1
+7 QUIT
