VSITASK ;ISD/RJP - Prompt User ;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;
;
VSIT(DFN,LST) ; - prompt user to select visit
; - called by VSIT
;
; - pass DFN = <patient record number>
; LST = <passed by reference, array of matching visits VSITGET>
; - rtns = <visit record # selected>
;
N X,Y,NOD,VSITI,X1,X2,DIR
D:$D(DFN)&$D(LST)
. S X="Visits for "_$P(^DPT(DFN,0),"^")
. S Y="",$P(Y,"-",$L(X)+1)="" W !,X,!,Y,!
. F VSITI=1:1:LST S NOD=$G(LST(VSITI)) Q:NOD="" D
. . D FMT(+$P(NOD,"|"))
. . W $J(VSITI,2)_" - ",?5,X1,!,?5,X2,!
. S DIR(0)="NA^1:"_LST
. S DIR("A")="Select Visit (1-"_LST_"): "
. S DIR("B")="1" D ^DIR
Q $G(Y)
;
FMT(IEN) ; - format display lines for a visit
;
; - pass IEN = <visit record #>
; - rtns X1,X2 = <formatted display lines>
;
N VSITI,VSIT,X,Y
S IEN=$G(IEN),(X1,X2)=""
D SLC^VSITVAR(IEN,"VDT^SVC^INS^TYP^ELG^LOC^DSS","E")
S X=$P(VSIT("VDT"),"^",2),X1=X_$E($J("",80),$L(X)+1,27)
S X=$E($P(VSIT("SVC"),"^",2),1,18),X1=X1_X_" "
S X=$E($P(VSIT("INS"),"^",2),1,18),X1=X1_X_" "
S X=$E($P($P(VSIT("TYP"),"^",2)," "),1,8),X1=X1_"("_X_")"
S X=$S($P(VSIT("ELG"),"^",2)]"":" Elig: ",1:"")_$E($P(VSIT("ELG"),"^",2),1,13),X2=X2_X_$E($J("",80),$L(X)+1,22)
S X="Loc: "_$E($P(VSIT("LOC"),"^",2),1,18),X2=X2_X_$E($J("",80),$L(X)+1,20)
S X="Cat: "_$E($P(VSIT("DSS"),"^",2),1,18),X2=X2_X_$E($J("",80),$L(X)+1,20)
Q
;
ELG(PAT) ; - prompt user to select pt. eligibility
; - called by VSITCK1
;
; - pass PAT = <patient record number>
; rtns = <selected eligibility>
;
N X,Y,DIC,D,DZ S PAT=$$GET^VSITVAR("PAT",PAT,"B")
S X="Eligibilities for "_$P(PAT,"^",2)
S Y="",$P(Y,"-",$L(X)+1)="" W !,X,!,Y
S DIC(0)="AEQMZ",DIC="^DIC(8,"
S DIC("S")="I $D(^DPT(+PAT,""E"",+Y,0))"
I $G(^DPT(+PAT,.36)) S DIC("B")=$P(^DIC(8,+^(.36),0),"^")
S DIC("A")="Select Eligibility for this Visit: "
S D="B",DZ="??" D DQ^DICQ K D,DZ F D ^DIC Q:Y>0 W " Required!"
Q $P(Y,"^")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVSITASK 2273 printed Oct 16, 2024@18:33:02 Page 2
VSITASK ;ISD/RJP - Prompt User ;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 ;
VSIT(DFN,LST) ; - prompt user to select visit
+1 ; - called by VSIT
+2 ;
+3 ; - pass DFN = <patient record number>
+4 ; LST = <passed by reference, array of matching visits VSITGET>
+5 ; - rtns = <visit record # selected>
+6 ;
+7 NEW X,Y,NOD,VSITI,X1,X2,DIR
+8 if $DATA(DFN)&$DATA(LST)
Begin DoDot:1
+9 SET X="Visits for "_$PIECE(^DPT(DFN,0),"^")
+10 SET Y=""
SET $PIECE(Y,"-",$LENGTH(X)+1)=""
WRITE !,X,!,Y,!
+11 FOR VSITI=1:1:LST
SET NOD=$GET(LST(VSITI))
if NOD=""
QUIT
Begin DoDot:2
+12 DO FMT(+$PIECE(NOD,"|"))
+13 WRITE $JUSTIFY(VSITI,2)_" - ",?5,X1,!,?5,X2,!
End DoDot:2
+14 SET DIR(0)="NA^1:"_LST
+15 SET DIR("A")="Select Visit (1-"_LST_"): "
+16 SET DIR("B")="1"
DO ^DIR
End DoDot:1
+17 QUIT $GET(Y)
+18 ;
FMT(IEN) ; - format display lines for a visit
+1 ;
+2 ; - pass IEN = <visit record #>
+3 ; - rtns X1,X2 = <formatted display lines>
+4 ;
+5 NEW VSITI,VSIT,X,Y
+6 SET IEN=$GET(IEN)
SET (X1,X2)=""
+7 DO SLC^VSITVAR(IEN,"VDT^SVC^INS^TYP^ELG^LOC^DSS","E")
+8 SET X=$PIECE(VSIT("VDT"),"^",2)
SET X1=X_$EXTRACT($JUSTIFY("",80),$LENGTH(X)+1,27)
+9 SET X=$EXTRACT($PIECE(VSIT("SVC"),"^",2),1,18)
SET X1=X1_X_" "
+10 SET X=$EXTRACT($PIECE(VSIT("INS"),"^",2),1,18)
SET X1=X1_X_" "
+11 SET X=$EXTRACT($PIECE($PIECE(VSIT("TYP"),"^",2)," "),1,8)
SET X1=X1_"("_X_")"
+12 SET X=$SELECT($PIECE(VSIT("ELG"),"^",2)]"":" Elig: ",1:"")_$EXTRACT($PIECE(VSIT("ELG"),"^",2),1,13)
SET X2=X2_X_$EXTRACT($JUSTIFY("",80),$LENGTH(X)+1,22)
+13 SET X="Loc: "_$EXTRACT($PIECE(VSIT("LOC"),"^",2),1,18)
SET X2=X2_X_$EXTRACT($JUSTIFY("",80),$LENGTH(X)+1,20)
+14 SET X="Cat: "_$EXTRACT($PIECE(VSIT("DSS"),"^",2),1,18)
SET X2=X2_X_$EXTRACT($JUSTIFY("",80),$LENGTH(X)+1,20)
+15 QUIT
+16 ;
ELG(PAT) ; - prompt user to select pt. eligibility
+1 ; - called by VSITCK1
+2 ;
+3 ; - pass PAT = <patient record number>
+4 ; rtns = <selected eligibility>
+5 ;
+6 NEW X,Y,DIC,D,DZ
SET PAT=$$GET^VSITVAR("PAT",PAT,"B")
+7 SET X="Eligibilities for "_$PIECE(PAT,"^",2)
+8 SET Y=""
SET $PIECE(Y,"-",$LENGTH(X)+1)=""
WRITE !,X,!,Y
+9 SET DIC(0)="AEQMZ"
SET DIC="^DIC(8,"
+10 SET DIC("S")="I $D(^DPT(+PAT,""E"",+Y,0))"
+11 IF $GET(^DPT(+PAT,.36))
SET DIC("B")=$PIECE(^DIC(8,+^(.36),0),"^")
+12 SET DIC("A")="Select Eligibility for this Visit: "
+13 SET D="B"
SET DZ="??"
DO DQ^DICQ
KILL D,DZ
FOR
DO ^DIC
if Y>0
QUIT
WRITE " Required!"
+14 QUIT $PIECE(Y,"^")
