- BLRDPT31 ; IHS/DIR/FJE - PATIENT VARIABLES ;
- ;;5.2;BLR;;NOV 01, 1997
- ;
- ;;MAS VERSION 5.0;
- ;Inpatient variables [Version 5.0 and above]
- EN N VAINDT,VAMV,VAMV0
- S VAMV=+E,VAMV0=^DGPM(VAMV,0),VAX("CA")=+$P(VAMV0,"^",14) G ENQ:'$D(^DGPM(+VAX("CA"),0))
- I $D(VAIP("M")) D CE G ENQ:'$D(^DGPM(+E,0)) S VAMV=+E,VAMV0=^(0)
- S @VAV@($P(VAS,"^",1))=E
- S Y=$P(VAMV0,"^",2),@VAV@($P(VAS,"^",2))=Y_"^"_$S($D(^DG(405.3,+Y,0)):$P(^(0),"^"),1:"")
- S Y=$S(+VAMV0:+VAMV0,1:"") X:Y ^DD("DD") S @VAV@($P(VAS,"^",3))=+VAMV0_"^"_Y
- S Y=$P(VAMV0,"^",18),@VAV@($P(VAS,"^",4))=Y_"^"_$S($D(^DG(405.2,+Y,0)):$P(^(0),"^"),1:"")
- S Y=+$P(^DGPM(VAX("CA"),0),"^",16) S:Y @VAV@($P(VAS,"^",12))=Y
- ;
- S VATD=VAX("DT") D FIND
- S @VAV@($P(VAS,"^",5))=VAWD,@VAV@($P(VAS,"^",6))=VARM,@VAV@($P(VAS,"^",7))=VAPP,@VAV@($P(VAS,"^",8))=VATS,@VAV@($P(VAS,"^",9))=VADX
- ;
- S VAINDT=+VAMV0 D IB^BLRDPT2 S @VAV@($P(VAS,"^",10))=+VAZ
- I 'VAZ,$D(VAZ(2)),VAZ(2)?7N!(VAZ(2)?7N1".".N) S Y=VAZ(2) X ^DD("DD") S @VAV@($P(VAS,"^",11))=VAZ(2)_"^"_Y
- ;
- I $D(VAIP("M")) S VASET=$S(VAIP("M"):14,1:13),VASET(VASET)="",VANODE=$P(VAS,"^",VASET) D COPY ; last or adm
- I '$D(VAIP("M")),$D(VAIP("D")),"^l^L^"[("^"_$E(VAIP("D"))_"^") S VASET(14)="",VANODE=$P(VAS,"^",14) D COPY ; last
- I "^3^5^"[("^"_$P(VAMV0,"^",2)_"^") S VASET(17)="",VANODE=$P(VAS,"^",17) D COPY ; d/c
- I '$D(VASET(13)) S VAMV=VAX("CA"),VAMV0=^DGPM(VAMV,0),VANODE=$P(VAS,"^",13) D STORE ; adm
- D BLD^BLRDPT32 G ENQ:'$D(^UTILITY("VADPTZ",$J,DFN))
- S VAXE=$S($D(^UTILITY("VADPTZ",$J,DFN,1)):^(1),1:""),VAMV0=$P(VAXE,"||",2),VAMV=+VAXE
- I VAMV,"^3^5^"[("^"_$P(VAMV0,"^",2)_"^"),'$D(VASET(17)) S VANODE=$P(VAS,"^",17) D STORE ; d/c
- I VAMV,'$D(VASET(14)) S VANODE=$P(VAS,"^",14) D STORE ;last
- I $S('VANN:1,'$D(^UTILITY("VADPTZ",$J,DFN,+VANN)):1,1:0) G ENQ
- I $D(^UTILITY("VADPTZ",$J,DFN,VANN-1)) S VAXE=^(VANN-1),VAMV=+VAXE,VAMV0=$P(VAXE,"||",2) I VAMV S VANODE=$P(VAS,"^",16) D STORE ; following
- I $D(^UTILITY("VADPTZ",$J,DFN,VANN+1)) S VAXE=^(VANN+1),VAMV=+VAXE,VAMV0=$P(VAXE,"||",2) I VAMV S VANODE=$P(VAS,"^",15) D STORE ; prior
- ;
- ENQ K VAMVX,VANODE,VAMCC,VAXE,VANN D KVAR^BLRDPT30 Q
- ;
- FIND ;
- S VAMVX=VAMV,VAMV0X=VAMV0
- S (VAWD,VATS,VAMV,VARM,VAPP,VADX)=""
- I $P(VAMV0,"^",2)=4!($P(VAMV0,"^",2)=5) D LODGER G FINDQ
- S VATD=9999999.999999-VATD,(VACN,VAPRC,VAPRT)=1 D GET^BLRDPT30
- FINDQ S VAMV=VAMVX,VAMV0=VAMV0X K VAMVX,VAMV0X
- Q
- ;
- CE I 'VAIP("M") S E=+VAX("CA") Q
- S E=$O(^DGPM("APMV",DFN,+VAX("CA"),0)) Q:E'>0 S E=$O(^DGPM("APMV",DFN,+VAX("CA"),E,0)) Q
- ;
- STORE ; store 'other nodes'
- S @VAV@(VANODE)=+VAMV
- S Y=+VAMV0 X:Y ^DD("DD") S @VAV@(VANODE,1)=+VAMV0_"^"_Y
- S Y=$P(VAMV0,"^",2),@VAV@(VANODE,2)=Y_"^"_$S($D(^DG(405.3,+Y,0)):$P(^(0),"^"),1:"")
- S Y=$P(VAMV0,"^",18),@VAV@(VANODE,3)=Y_"^"_$S($D(^DG(405.2,+Y,0)):$P(^(0),"^"),1:"")
- S VATD=+VAMV0 D FIND
- S @VAV@(VANODE,4)=VAWD,@VAV@(VANODE,5)=VAPP,@VAV@(VANODE,6)=VATS,@VAV@(VANODE,7)=VADX
- Q
- ;
- COPY ; copy from primary to other nodes
- S @VAV@(VANODE)=VAMV
- ; 1-mvt d/t ; 2-transaction type ; 3-mvt type
- S @VAV@(VANODE,1)=@VAV@($P(VAS,"^",3)),@VAV@(VANODE,2)=@VAV@($P(VAS,"^",2)),@VAV@(VANODE,3)=@VAV@($P(VAS,"^",4))
- ; 4-ward ; 5-doc ; 6-treat spec ; 7-dx
- S @VAV@(VANODE,4)=@VAV@($P(VAS,"^",5)),@VAV@(VANODE,5)=@VAV@($P(VAS,"^",7)),@VAV@(VANODE,6)=@VAV@($P(VAS,"^",8)),@VAV@(VANODE,7)=@VAV@($P(VAS,"^",9))
- Q
- ;
- LODGER ; -- get lodger data
- S VAWD=$S($P(VAMV0,"^",2)=4:$P(VAMV0,"^",6),$D(^DGPM(+$P(VAMV0,"^",14),0)):$P(^(0),"^",6),1:"")
- S VAWD=$S($D(^DIC(42,+VAWD,0)):VAWD_"^"_$P(^(0),"^"),1:"")
- S VARM=$S($P(VAMV0,"^",2)=4:$P(VAMV0,"^",7),$D(^DGPM(+$P(VAMV0,"^",14),0)):$P(^(0),"^",7),1:"")
- S VARM=$S($D(^DG(405.4,+VARM,0)):VARM_"^"_$P(^(0),"^"),1:"")
- Q
- BLRDPT31 ; IHS/DIR/FJE - PATIENT VARIABLES ;
- +1 ;;5.2;BLR;;NOV 01, 1997
- +2 ;
- +3 ;;MAS VERSION 5.0;
- +4 ;Inpatient variables [Version 5.0 and above]
- EN NEW VAINDT,VAMV,VAMV0
- +1 SET VAMV=+E
- SET VAMV0=^DGPM(VAMV,0)
- SET VAX("CA")=+$PIECE(VAMV0,"^",14)
- IF '$DATA(^DGPM(+VAX("CA"),0))
- GOTO ENQ
- +2 IF $DATA(VAIP("M"))
- DO CE
- IF '$DATA(^DGPM(+E,0))
- GOTO ENQ
- SET VAMV=+E
- SET VAMV0=^(0)
- +3 SET @VAV@($PIECE(VAS,"^",1))=E
- +4 SET Y=$PIECE(VAMV0,"^",2)
- SET @VAV@($PIECE(VAS,"^",2))=Y_"^"_$SELECT($DATA(^DG(405.3,+Y,0)):$PIECE(^(0),"^"),1:"")
- +5 SET Y=$SELECT(+VAMV0:+VAMV0,1:"")
- IF Y
- XECUTE ^DD("DD")
- SET @VAV@($PIECE(VAS,"^",3))=+VAMV0_"^"_Y
- +6 SET Y=$PIECE(VAMV0,"^",18)
- SET @VAV@($PIECE(VAS,"^",4))=Y_"^"_$SELECT($DATA(^DG(405.2,+Y,0)):$PIECE(^(0),"^"),1:"")
- +7 SET Y=+$PIECE(^DGPM(VAX("CA"),0),"^",16)
- IF Y
- SET @VAV@($PIECE(VAS,"^",12))=Y
- +8 ;
- +9 SET VATD=VAX("DT")
- DO FIND
- +10 SET @VAV@($PIECE(VAS,"^",5))=VAWD
- SET @VAV@($PIECE(VAS,"^",6))=VARM
- SET @VAV@($PIECE(VAS,"^",7))=VAPP
- SET @VAV@($PIECE(VAS,"^",8))=VATS
- SET @VAV@($PIECE(VAS,"^",9))=VADX
- +11 ;
- +12 SET VAINDT=+VAMV0
- DO IB^BLRDPT2
- SET @VAV@($PIECE(VAS,"^",10))=+VAZ
- +13 IF 'VAZ
- IF $DATA(VAZ(2))
- IF VAZ(2)?7N!(VAZ(2)?7N1".".N)
- SET Y=VAZ(2)
- XECUTE ^DD("DD")
- SET @VAV@($PIECE(VAS,"^",11))=VAZ(2)_"^"_Y
- +14 ;
- +15 ; last or adm
- IF $DATA(VAIP("M"))
- SET VASET=$SELECT(VAIP("M"):14,1:13)
- SET VASET(VASET)=""
- SET VANODE=$PIECE(VAS,"^",VASET)
- DO COPY
- +16 ; last
- IF '$DATA(VAIP("M"))
- IF $DATA(VAIP("D"))
- IF "^l^L^"[("^"_$EXTRACT(VAIP("D"))_"^")
- SET VASET(14)=""
- SET VANODE=$PIECE(VAS,"^",14)
- DO COPY
- +17 ; d/c
- IF "^3^5^"[("^"_$PIECE(VAMV0,"^",2)_"^")
- SET VASET(17)=""
- SET VANODE=$PIECE(VAS,"^",17)
- DO COPY
- +18 ; adm
- IF '$DATA(VASET(13))
- SET VAMV=VAX("CA")
- SET VAMV0=^DGPM(VAMV,0)
- SET VANODE=$PIECE(VAS,"^",13)
- DO STORE
- +19 DO BLD^BLRDPT32
- IF '$DATA(^UTILITY("VADPTZ",$JOB,DFN))
- GOTO ENQ
- +20 SET VAXE=$SELECT($DATA(^UTILITY("VADPTZ",$JOB,DFN,1)):^(1),1:"")
- SET VAMV0=$PIECE(VAXE,"||",2)
- SET VAMV=+VAXE
- +21 ; d/c
- IF VAMV
- IF "^3^5^"[("^"_$PIECE(VAMV0,"^",2)_"^")
- IF '$DATA(VASET(17))
- SET VANODE=$PIECE(VAS,"^",17)
- DO STORE
- +22 ;last
- IF VAMV
- IF '$DATA(VASET(14))
- SET VANODE=$PIECE(VAS,"^",14)
- DO STORE
- +23 IF $SELECT('VANN:1,'$DATA(^UTILITY("VADPTZ",$JOB,DFN,+VANN)):1,1:0)
- GOTO ENQ
- +24 ; following
- IF $DATA(^UTILITY("VADPTZ",$JOB,DFN,VANN-1))
- SET VAXE=^(VANN-1)
- SET VAMV=+VAXE
- SET VAMV0=$PIECE(VAXE,"||",2)
- IF VAMV
- SET VANODE=$PIECE(VAS,"^",16)
- DO STORE
- +25 ; prior
- IF $DATA(^UTILITY("VADPTZ",$JOB,DFN,VANN+1))
- SET VAXE=^(VANN+1)
- SET VAMV=+VAXE
- SET VAMV0=$PIECE(VAXE,"||",2)
- IF VAMV
- SET VANODE=$PIECE(VAS,"^",15)
- DO STORE
- +26 ;
- ENQ KILL VAMVX,VANODE,VAMCC,VAXE,VANN
- DO KVAR^BLRDPT30
- QUIT
- +1 ;
- FIND ;
- +1 SET VAMVX=VAMV
- SET VAMV0X=VAMV0
- +2 SET (VAWD,VATS,VAMV,VARM,VAPP,VADX)=""
- +3 IF $PIECE(VAMV0,"^",2)=4!($PIECE(VAMV0,"^",2)=5)
- DO LODGER
- GOTO FINDQ
- +4 SET VATD=9999999.999999-VATD
- SET (VACN,VAPRC,VAPRT)=1
- DO GET^BLRDPT30
- FINDQ SET VAMV=VAMVX
- SET VAMV0=VAMV0X
- KILL VAMVX,VAMV0X
- +1 QUIT
- +2 ;
- CE IF 'VAIP("M")
- SET E=+VAX("CA")
- QUIT
- +1 SET E=$ORDER(^DGPM("APMV",DFN,+VAX("CA"),0))
- IF E'>0
- QUIT
- SET E=$ORDER(^DGPM("APMV",DFN,+VAX("CA"),E,0))
- QUIT
- +2 ;
- STORE ; store 'other nodes'
- +1 SET @VAV@(VANODE)=+VAMV
- +2 SET Y=+VAMV0
- IF Y
- XECUTE ^DD("DD")
- SET @VAV@(VANODE,1)=+VAMV0_"^"_Y
- +3 SET Y=$PIECE(VAMV0,"^",2)
- SET @VAV@(VANODE,2)=Y_"^"_$SELECT($DATA(^DG(405.3,+Y,0)):$PIECE(^(0),"^"),1:"")
- +4 SET Y=$PIECE(VAMV0,"^",18)
- SET @VAV@(VANODE,3)=Y_"^"_$SELECT($DATA(^DG(405.2,+Y,0)):$PIECE(^(0),"^"),1:"")
- +5 SET VATD=+VAMV0
- DO FIND
- +6 SET @VAV@(VANODE,4)=VAWD
- SET @VAV@(VANODE,5)=VAPP
- SET @VAV@(VANODE,6)=VATS
- SET @VAV@(VANODE,7)=VADX
- +7 QUIT
- +8 ;
- COPY ; copy from primary to other nodes
- +1 SET @VAV@(VANODE)=VAMV
- +2 ; 1-mvt d/t ; 2-transaction type ; 3-mvt type
- +3 SET @VAV@(VANODE,1)=@VAV@($PIECE(VAS,"^",3))
- SET @VAV@(VANODE,2)=@VAV@($PIECE(VAS,"^",2))
- SET @VAV@(VANODE,3)=@VAV@($PIECE(VAS,"^",4))
- +4 ; 4-ward ; 5-doc ; 6-treat spec ; 7-dx
- +5 SET @VAV@(VANODE,4)=@VAV@($PIECE(VAS,"^",5))
- SET @VAV@(VANODE,5)=@VAV@($PIECE(VAS,"^",7))
- SET @VAV@(VANODE,6)=@VAV@($PIECE(VAS,"^",8))
- SET @VAV@(VANODE,7)=@VAV@($PIECE(VAS,"^",9))
- +6 QUIT
- +7 ;
- LODGER ; -- get lodger data
- +1 SET VAWD=$SELECT($PIECE(VAMV0,"^",2)=4:$PIECE(VAMV0,"^",6),$DATA(^DGPM(+$PIECE(VAMV0,"^",14),0)):$PIECE(^(0),"^",6),1:"")
- +2 SET VAWD=$SELECT($DATA(^DIC(42,+VAWD,0)):VAWD_"^"_$PIECE(^(0),"^"),1:"")
- +3 SET VARM=$SELECT($PIECE(VAMV0,"^",2)=4:$PIECE(VAMV0,"^",7),$DATA(^DGPM(+$PIECE(VAMV0,"^",14),0)):$PIECE(^(0),"^",7),1:"")
- +4 SET VARM=$SELECT($DATA(^DG(405.4,+VARM,0)):VARM_"^"_$PIECE(^(0),"^"),1:"")
- +5 QUIT
