- VSITVAR ;ISD/RJP - Define Visit Array Variables ;6/20/96
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**76**;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.
- ;
- ;;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
- S REC(0)=$G(^AUPNVSIT(IEN,0)) F S VSITI=$O(^(VSITI)) Q:VSITI'>0 S REC(VSITI)=^(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:"")
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVSITVAR 4118 printed Feb 18, 2025@23:58:59 Page 2
- VSITVAR ;ISD/RJP - Define Visit Array Variables ;6/20/96
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**76**;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 ;
- +7 ;;2.0;VISIT TRACKING;;Aug 12, 1996;
- +8 QUIT
- +9 ;
- +10 ; - IEN = <visit record number>
- +11 ; FLD = <field mnemonic>
- +12 ; VAL = <data value>
- +13 ; VSITDD0 = <indirect reference to dd for field>
- +14 ; FMT = <output format [I:internal/E:external/B:both]>
- +15 ; WITHIEN = 1: first subscript of VSIT array is IEN second is field.
- +16 ; 0,"",not passed: field is only subscript
- +17 ;
- 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 SET REC(0)=$GET(^AUPNVSIT(IEN,0))
- FOR
- SET VSITI=$ORDER(^(VSITI))
- if VSITI'>0
- QUIT
- SET REC(VSITI)=^(VSITI)
- +7 SET FLDINDX=""
- +8 FOR
- SET FLDINDX=$ORDER(^TMP("VSITDD",$JOB,FLDINDX))
- if FLDINDX=""
- QUIT
- Begin DoDot:1
- +9 SET FLD=$GET(^TMP("VSITDD",$JOB,FLDINDX))
- +10 SET VAL=$PIECE($GET(REC($PIECE(FLD,";",3))),"^",$PIECE(FLD,";",4))
- +11 IF WITHIEN
- SET VSIT(IEN,FLDINDX)=$$GET(FLDINDX,VAL,FMT)
- +12 IF '$TEST
- SET VSIT(FLDINDX)=$$GET(FLDINDX,VAL,FMT)
- End DoDot:1
- +13 QUIT
- +14 ;
- 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:"")
