VSITVAR ;ISD/RJP - Define Visit Array Variables ;24-Oct-2013 09:49;DU
;;1.0;PCE PATIENT CARE ENCOUNTER;**76,1001**;Aug 12, 1996
; Patch PX*1*76 changes the 2nd line of all VSIT* routines to reflect
; the incorporation of the module into PCE. For historical reference,
; the old (VISIT TRACKING) 2nd line is included below to reference VSIT
; patches.
; Modified - IHS/MSC/PLS - 10/24/2013 - Line ALL+6
;
;;2.0;VISIT TRACKING;;Aug 12, 1996;
Q
;
; - IEN = <visit record number>
; FLD = <field mnemonic>
; VAL = <data value>
; VSITDD0 = <indirect reference to dd for field>
; FMT = <output format [I:internal/E:external/B:both]>
; WITHIEN = 1: first subscript of VSIT array is IEN second is field.
; 0,"",not passed: field is only subscript
;
ALL(IEN,FMT,WITHIEN) ; - define all VSIT("xxx") nodes using record # IEN
;
N REC,FLD,FLDINDX,VAL,VSITI
S IEN=+$G(IEN),FMT=$G(FMT),WITHIEN=$G(WITHIEN)
D:'($D(^TMP("VSITDD",$J))\10) FLD^VSITFLD
S VSITI=0
;IHS/MSC/PLS - 10/24/2013
;S REC(0)=$G(^AUPNVSIT(IEN,0)) F S VSITI=$O(^(VSITI)) Q:VSITI'>0 S REC(VSITI)=^(VSITI)
S REC(0)=$G(^AUPNVSIT(IEN,0)) F S VSITI=$O(^(VSITI)) Q:VSITI'>0 S REC(VSITI)=$G(^(VSITI))
S FLDINDX=""
F S FLDINDX=$O(^TMP("VSITDD",$J,FLDINDX)) Q:FLDINDX="" D
. S FLD=$G(^TMP("VSITDD",$J,FLDINDX))
. S VAL=$P($G(REC($P(FLD,";",3))),"^",$P(FLD,";",4))
. I WITHIEN S VSIT(IEN,FLDINDX)=$$GET(FLDINDX,VAL,FMT)
. E S VSIT(FLDINDX)=$$GET(FLDINDX,VAL,FMT)
Q
;
SLC(IEN,FLD,FMT) ; - define only VSIT(FLD) node using record # IEN
;
N REC,NXT,VAL,VSITI
S IEN=$G(IEN),FLD=$G(FLD),FMT=$G(FMT)
D:'($D(^TMP("VSITDD",$J))\10) FLD^VSITFLD
F VSITI=1:1:$L(FLD,"^") S NXT=$P(FLD,"^",VSITI) D:NXT]""
. D:$G(REC($P(^TMP("VSITDD",$J,NXT),";",3)))=""
. . S REC($P(^TMP("VSITDD",$J,NXT),";",3))=$G(^AUPNVSIT(IEN,$P(^TMP("VSITDD",$J,NXT),";",3)))
. S VAL=$P($G(REC($P(^TMP("VSITDD",$J,NXT),";",3))),"^",$P(^TMP("VSITDD",$J,NXT),";",4))
. S VSIT(NXT)=$$GET(NXT,VAL,FMT)
K FMT
Q
;
; ---------------------------------------------------------------------
;
GET(FLD,VAL,FMT,DATEFMT) ; - Get/Check value for field
;
N X,Y,VSITDD0
S FLD=$G(FLD),VAL=$G(VAL),FMT=$G(FMT)
D:'($D(^TMP("VSITDD",$J))\10) FLD^VSITFLD
S Y=""
S FLD=$G(^TMP("VSITDD",$J,FLD))
D:FLD]""
. S VSITDD0=$P($G(^DD(9000010,$P(FLD,";",2),0)),"^",2)
. S Y=$S(VSITDD0["N":"TXT",VSITDD0["F":"TXT",VSITDD0["P":"PTR",VSITDD0["S":"SET",VSITDD0["D":"DAT",1:"")
. S VSITDD0="^DD(9000010,"_$P(FLD,";",2)_",0)"
Q $S(Y="TXT":$$TXT(VAL,FMT),Y="DAT":$$DAT(VAL,FMT,$G(DATEFMT)),Y="SET":$$SET(VAL,FMT,VSITDD0),Y="PTR":$$PTR(VAL,FMT,VSITDD0),1:"")
;
TXT(VAL,FMT) ; - number/free text valued data
;
S VAL=$G(VAL),FMT=$G(FMT),FMT=$S(FMT]""&("IEB"[FMT):FMT,1:"I")
Q $S("IB"[FMT:VAL,1:"")_$S("EB"[FMT:$S(VAL]"":"^",1:"")_VAL,1:"")
;
DAT(VAL,FMT,DATEFMT) ; - date valued data
;
N X,Y,%DT
S VAL=$G(VAL),FMT=$G(FMT),FMT=$S(FMT]""&("IEB"[FMT):FMT,1:"I")
S %DT=$S($G(DATEFMT)]"":DATEFMT,1:"TSX")
S X=VAL
D ^%DT K %DT S VAL=$S(Y>0:Y,1:"")
S:"EB"[FMT&(Y]"") Y=$$FMTE^XLFDT(VAL,"1P")
Q $S("IB"[FMT:VAL,1:"")_$S("EB"[FMT:$S(Y]"":"^",1:"")_Y,1:"")
;
SET(VAL,FMT,VSITDD0) ; - set of codes valued data
;
N Y S Y=""
S VAL=$G(VAL),FMT=$G(FMT),FMT=$S(FMT]""&("IEB"[FMT):FMT,1:"I")
S VSITDD0=$G(@VSITDD0),VSITDD0=$S($P(VSITDD0,"^",2)'["S":"",1:";"_$P(VSITDD0,"^",3))
D:VAL]""
. I VSITDD0[(";"_$P(VAL,"^")_":") S Y=$P(VSITDD0,";",$L($E(VSITDD0,1,$F(VSITDD0,";"_$P(VAL,"^")_":")),";")) ; - internal code
. E S Y=$P(VSITDD0,";",$L($E(VSITDD0,1,$F(VSITDD0,":"_$TR(VAL,"^"))-1),";")) ; - external code
. S Y=$TR(Y,":","^")
Q $S("IB"[FMT:$P(Y,"^"),1:"")_$S("EB"[FMT:$S($P(Y,"^",2)]"":"^",1:"")_$P(Y,"^",2),1:"")
;
PTR(VAL,FMT,VSITDD0) ; - pointer valued data
;
N D,Y,DIC S VAL=$G(VAL),FMT=$G(FMT),FMT=$S(FMT]""&("IEB"[FMT):FMT,1:"I")
S VSITDD0=$G(@VSITDD0),Y="" D:$P(VSITDD0,"^",2)["P"
. F I $D(@("^"_$P(^(0),"^",3)_"0)")) S VSITDD0=$P(^(0),"^",2) Q:'$D(^(+VAL,0)) S Y=$P(^(0),"^") I $D(^DD(+VSITDD0,.01,0)) S VSITDD0=$P(^(0),"^",2) Q:VSITDD0'["P"
S:Y]"" Y=VAL_"^"_Y
I +VSITDD0,'+$P(Y,"^") S X=VAL,DIC=+VSITDD0,DIC(0)="N",D="B" D IX^DIC S Y=$S(Y>0:Y,1:"")
Q $S("IB"[FMT:$P(Y,"^"),1:"")_$S("EB"[FMT:$S($P(Y,"^",2)]"":"^",1:"")_$P(Y,"^",2),1:"")
VSITVAR ;ISD/RJP - Define Visit Array Variables ;24-Oct-2013 09:49;DU
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**76,1001**;Aug 12, 1996
+2 ; Patch PX*1*76 changes the 2nd line of all VSIT* routines to reflect
+3 ; the incorporation of the module into PCE. For historical reference,
+4 ; the old (VISIT TRACKING) 2nd line is included below to reference VSIT
+5 ; patches.
+6 ; Modified - IHS/MSC/PLS - 10/24/2013 - Line ALL+6
+7 ;
+8 ;;2.0;VISIT TRACKING;;Aug 12, 1996;
+9 QUIT
+10 ;
+11 ; - IEN = <visit record number>
+12 ; FLD = <field mnemonic>
+13 ; VAL = <data value>
+14 ; VSITDD0 = <indirect reference to dd for field>
+15 ; FMT = <output format [I:internal/E:external/B:both]>
+16 ; WITHIEN = 1: first subscript of VSIT array is IEN second is field.
+17 ; 0,"",not passed: field is only subscript
+18 ;
ALL(IEN,FMT,WITHIEN) ; - define all VSIT("xxx") nodes using record # IEN
+1 ;
+2 NEW REC,FLD,FLDINDX,VAL,VSITI
+3 SET IEN=+$GET(IEN)
SET FMT=$GET(FMT)
SET WITHIEN=$GET(WITHIEN)
+4 IF '($DATA(^TMP("VSITDD",$JOB))\10)
DO FLD^VSITFLD
+5 SET VSITI=0
+6 ;IHS/MSC/PLS - 10/24/2013
+7 ;S REC(0)=$G(^AUPNVSIT(IEN,0)) F S VSITI=$O(^(VSITI)) Q:VSITI'>0 S REC(VSITI)=^(VSITI)
+8 SET REC(0)=$GET(^AUPNVSIT(IEN,0))
FOR
SET VSITI=$ORDER(^(VSITI))
IF VSITI'>0
QUIT
SET REC(VSITI)=$GET(^(VSITI))
+9 SET FLDINDX=""
+10 FOR
SET FLDINDX=$ORDER(^TMP("VSITDD",$JOB,FLDINDX))
IF FLDINDX=""
QUIT
Begin DoDot:1
+11 SET FLD=$GET(^TMP("VSITDD",$JOB,FLDINDX))
+12 SET VAL=$PIECE($GET(REC($PIECE(FLD,";",3))),"^",$PIECE(FLD,";",4))
+13 IF WITHIEN
SET VSIT(IEN,FLDINDX)=$$GET(FLDINDX,VAL,FMT)
+14 IF '$TEST
SET VSIT(FLDINDX)=$$GET(FLDINDX,VAL,FMT)
End DoDot:1
+15 QUIT
+16 ;
SLC(IEN,FLD,FMT) ; - define only VSIT(FLD) node using record # IEN
+1 ;
+2 NEW REC,NXT,VAL,VSITI
+3 SET IEN=$GET(IEN)
SET FLD=$GET(FLD)
SET FMT=$GET(FMT)
+4 IF '($DATA(^TMP("VSITDD",$JOB))\10)
DO FLD^VSITFLD
+5 FOR VSITI=1:1:$LENGTH(FLD,"^")
SET NXT=$PIECE(FLD,"^",VSITI)
IF NXT]""
Begin DoDot:1
+6 IF $GET(REC($PIECE(^TMP("VSITDD",$JOB,NXT),";",3)))=""
Begin DoDot:2
+7 SET REC($PIECE(^TMP("VSITDD",$JOB,NXT),";",3))=$GET(^AUPNVSIT(IEN,$PIECE(^TMP("VSITDD",$JOB,NXT),";",3)))
End DoDot:2
+8 SET VAL=$PIECE($GET(REC($PIECE(^TMP("VSITDD",$JOB,NXT),";",3))),"^",$PIECE(^TMP("VSITDD",$JOB,NXT),";",4))
+9 SET VSIT(NXT)=$$GET(NXT,VAL,FMT)
End DoDot:1
+10 KILL FMT
+11 QUIT
+12 ;
+13 ; ---------------------------------------------------------------------
+14 ;
GET(FLD,VAL,FMT,DATEFMT) ; - Get/Check value for field
+1 ;
+2 NEW X,Y,VSITDD0
+3 SET FLD=$GET(FLD)
SET VAL=$GET(VAL)
SET FMT=$GET(FMT)
+4 IF '($DATA(^TMP("VSITDD",$JOB))\10)
DO FLD^VSITFLD
+5 SET Y=""
+6 SET FLD=$GET(^TMP("VSITDD",$JOB,FLD))
+7 IF FLD]""
Begin DoDot:1
+8 SET VSITDD0=$PIECE($GET(^DD(9000010,$PIECE(FLD,";",2),0)),"^",2)
+9 SET Y=$SELECT(VSITDD0["N":"TXT",VSITDD0["F":"TXT",VSITDD0["P":"PTR",VSITDD0["S":"SET",VSITDD0["D":"DAT",1:"")
+10 SET VSITDD0="^DD(9000010,"_$PIECE(FLD,";",2)_",0)"
End DoDot:1
+11 QUIT $SELECT(Y="TXT":$$TXT(VAL,FMT),Y="DAT":$$DAT(VAL,FMT,$GET(DATEFMT)),Y="SET":$$SET(VAL,FMT,VSITDD0),Y="PTR":$$PTR(VAL,FMT,VSITDD0),1:"")
+12 ;
TXT(VAL,FMT) ; - number/free text valued data
+1 ;
+2 SET VAL=$GET(VAL)
SET FMT=$GET(FMT)
SET FMT=$SELECT(FMT]""&("IEB"[FMT):FMT,1:"I")
+3 QUIT $SELECT("IB"[FMT:VAL,1:"")_$SELECT("EB"[FMT:$SELECT(VAL]"":"^",1:"")_VAL,1:"")
+4 ;
DAT(VAL,FMT,DATEFMT) ; - date valued data
+1 ;
+2 NEW X,Y,%DT
+3 SET VAL=$GET(VAL)
SET FMT=$GET(FMT)
SET FMT=$SELECT(FMT]""&("IEB"[FMT):FMT,1:"I")
+4 SET %DT=$SELECT($GET(DATEFMT)]"":DATEFMT,1:"TSX")
+5 SET X=VAL
+6 DO ^%DT
KILL %DT
SET VAL=$SELECT(Y>0:Y,1:"")
+7 IF "EB"[FMT&(Y]"")
SET Y=$$FMTE^XLFDT(VAL,"1P")
+8 QUIT $SELECT("IB"[FMT:VAL,1:"")_$SELECT("EB"[FMT:$SELECT(Y]"":"^",1:"")_Y,1:"")
+9 ;
SET(VAL,FMT,VSITDD0) ; - set of codes valued data
+1 ;
+2 NEW Y
SET Y=""
+3 SET VAL=$GET(VAL)
SET FMT=$GET(FMT)
SET FMT=$SELECT(FMT]""&("IEB"[FMT):FMT,1:"I")
+4 SET VSITDD0=$GET(@VSITDD0)
SET VSITDD0=$SELECT($PIECE(VSITDD0,"^",2)'["S":"",1:";"_$PIECE(VSITDD0,"^",3))
+5 IF VAL]""
Begin DoDot:1
+6 ; - internal code
IF VSITDD0[(";"_$PIECE(VAL,"^")_":")
SET Y=$PIECE(VSITDD0,";",$LENGTH($EXTRACT(VSITDD0,1,$FIND(VSITDD0,";"_$PIECE(VAL,"^")_":")),";"))
+7 ; - external code
IF '$TEST
SET Y=$PIECE(VSITDD0,";",$LENGTH($EXTRACT(VSITDD0,1,$FIND(VSITDD0,":"_$TRANSLATE(VAL,"^"))-1),";"))
+8 SET Y=$TRANSLATE(Y,":","^")
End DoDot:1
+9 QUIT $SELECT("IB"[FMT:$PIECE(Y,"^"),1:"")_$SELECT("EB"[FMT:$SELECT($PIECE(Y,"^",2)]"":"^",1:"")_$PIECE(Y,"^",2),1:"")
+10 ;
PTR(VAL,FMT,VSITDD0) ; - pointer valued data
+1 ;
+2 NEW D,Y,DIC
SET VAL=$GET(VAL)
SET FMT=$GET(FMT)
SET FMT=$SELECT(FMT]""&("IEB"[FMT):FMT,1:"I")
+3 SET VSITDD0=$GET(@VSITDD0)
SET Y=""
IF $PIECE(VSITDD0,"^",2)["P"
Begin DoDot:1
+4 FOR
IF $DATA(@("^"_$PIECE(^(0),"^",3)_"0)"))
SET VSITDD0=$PIECE(^(0),"^",2)
IF '$DATA(^(+VAL,0))
QUIT
SET Y=$PIECE(^(0),"^")
IF $DATA(^DD(+VSITDD0,.01,0))
SET VSITDD0=$PIECE(^(0),"^",2)
IF VSITDD0'["P"
QUIT
End DoDot:1
+5 IF Y]""
SET Y=VAL_"^"_Y
+6 IF +VSITDD0
IF '+$PIECE(Y,"^")
SET X=VAL
SET DIC=+VSITDD0
SET DIC(0)="N"
SET D="B"
DO IX^DIC
SET Y=$SELECT(Y>0:Y,1:"")
+7 QUIT $SELECT("IB"[FMT:$PIECE(Y,"^"),1:"")_$SELECT("EB"[FMT:$SELECT($PIECE(Y,"^",2)]"":"^",1:"")_$PIECE(Y,"^",2),1:"")
