BDGSVE ; IHS/ANMC/LJF - SCHEDULED VISIT EDIT ;
;;5.3;PIMS;;APR 26, 2002
;
;
PAT ; ask user for patient
; If BDGSVEis set and = 1 then in edit mode, else in view mode
NEW DFN D KILL^AUPNPAT
S DFN=+$$READ^BDGF("PO^9000001:EMQZ","Select Patient") Q:DFN<1
;
PATSET ;EP; entry where patient already known
; find all entries in SV file for patient (except deleted ones)
; put into array sorted by date
NEW BDGN,COUNT,BDGA,BDGA1,X,PROMPT
S BDGN=0
F S BDGN=$O(^BDGSV("B",DFN,BDGN)) Q:'BDGN D
. Q:$$GET1^DIQ(9009016.7,BDGN,.16,"I")="ER" ;quit if entered in error
. S BDGA1(9999999-$$GET1^DIQ(9009016.7,BDGN,.02,"I"))=BDGN
;
; create numbered array linked to sorted array
S X=0 F S X=$O(BDGA1(X)) Q:'X D
. S COUNT=$G(COUNT)+1,BDGA(COUNT)=BDGA1(X)
;
; if no entries found, drop right into add mode
I '$D(BDGA) D Q
. W !!,"No Scheduled Visits found for patient"
. I '$G(BDGSVE) D PAUSE^BDGF Q
. Q:'$$READ^BDGF("Y","OKAY TO ADD NEW SCHEDULED VISIT","NO")
. D ADD,PAT
;
W !!,"Scheduled Visit Entries for "_$$GET1^DIQ(2,DFN,.01)_":"
F COUNT=1:1 Q:'$D(BDGA(COUNT)) Q:COUNT=10 D
. W !,$J(COUNT,3),?6,$$GET1^DIQ(9009016.7,BDGA(COUNT),.02) ;date
. W ?25,$$GET1^DIQ(9009016.7,BDGA(COUNT),.03)
. S X=$$GET1^DIQ(9009016.7,BDGA(COUNT),.16) ;disposition
. W ?45,$S(X]"":X,1:"Open/Pending")
W !
;
S PROMPT="Select Date by Number"
I $G(BDGSVE) S PROMPT=PROMPT_" or ""A"" to Add New Entry"
S Y=$$READ^BDGF("FO^1:"_$L(COUNT),PROMPT)
;
I Y="A",$G(BDGSVE) D ADD,PAT Q
I $D(BDGA(+Y)) S BDGN=BDGA(Y) D
. I $G(BDGSVE) D SCREEN,PAT Q ;edit then view
. D ^BDGSVS Q ;view only
Q
;
;
SCREEN ; -- call ScreenMan to add/edit parameters
NEW DDSFILE,DA,DR,X
S DDSFILE=9009016.7,DA=BDGN
S X=$$GET1^DIQ(9009016.7,BDGN,.03,"I") ;type of visit
S DR="[BDG SCHED "_$S(X="A":"ADMIT",X="D":"DAY SURGERY",1:"OUTPATIENT")_"]"
D ^DDS
I $$READ^BDGF("Y","Want to print Scheduled Visit Summary","NO") D ^BDGSVS
Q
;
ADD ; add new entry then call Screenman
NEW DIC,X,DA,DLAYGO
S (DIC,DLAYGO)=9009016.7,X=DFN,DIC(0)="AEMQLZ"
S DIC("DR")=".02;.03" K DO,DD D FILE^DICN
I Y S BDGN=+Y D SCREEN
Q
;
BDGSVE ; IHS/ANMC/LJF - SCHEDULED VISIT EDIT ;
+1 ;;5.3;PIMS;;APR 26, 2002
+2 ;
+3 ;
PAT ; ask user for patient
+1 ; If BDGSVEis set and = 1 then in edit mode, else in view mode
+2 NEW DFN
DO KILL^AUPNPAT
+3 SET DFN=+$$READ^BDGF("PO^9000001:EMQZ","Select Patient")
IF DFN<1
QUIT
+4 ;
PATSET ;EP; entry where patient already known
+1 ; find all entries in SV file for patient (except deleted ones)
+2 ; put into array sorted by date
+3 NEW BDGN,COUNT,BDGA,BDGA1,X,PROMPT
+4 SET BDGN=0
+5 FOR
SET BDGN=$ORDER(^BDGSV("B",DFN,BDGN))
IF 'BDGN
QUIT
Begin DoDot:1
+6 ;quit if entered in error
IF $$GET1^DIQ(9009016.7,BDGN,.16,"I")="ER"
QUIT
+7 SET BDGA1(9999999-$$GET1^DIQ(9009016.7,BDGN,.02,"I"))=BDGN
End DoDot:1
+8 ;
+9 ; create numbered array linked to sorted array
+10 SET X=0
FOR
SET X=$ORDER(BDGA1(X))
IF 'X
QUIT
Begin DoDot:1
+11 SET COUNT=$GET(COUNT)+1
SET BDGA(COUNT)=BDGA1(X)
End DoDot:1
+12 ;
+13 ; if no entries found, drop right into add mode
+14 IF '$DATA(BDGA)
Begin DoDot:1
+15 WRITE !!,"No Scheduled Visits found for patient"
+16 IF '$GET(BDGSVE)
DO PAUSE^BDGF
QUIT
+17 IF '$$READ^BDGF("Y","OKAY TO ADD NEW SCHEDULED VISIT","NO")
QUIT
+18 DO ADD
DO PAT
End DoDot:1
QUIT
+19 ;
+20 WRITE !!,"Scheduled Visit Entries for "_$$GET1^DIQ(2,DFN,.01)_":"
+21 FOR COUNT=1:1
IF '$DATA(BDGA(COUNT))
QUIT
IF COUNT=10
QUIT
Begin DoDot:1
+22 ;date
WRITE !,$JUSTIFY(COUNT,3),?6,$$GET1^DIQ(9009016.7,BDGA(COUNT),.02)
+23 WRITE ?25,$$GET1^DIQ(9009016.7,BDGA(COUNT),.03)
+24 ;disposition
SET X=$$GET1^DIQ(9009016.7,BDGA(COUNT),.16)
+25 WRITE ?45,$SELECT(X]"":X,1:"Open/Pending")
End DoDot:1
+26 WRITE !
+27 ;
+28 SET PROMPT="Select Date by Number"
+29 IF $GET(BDGSVE)
SET PROMPT=PROMPT_" or ""A"" to Add New Entry"
+30 SET Y=$$READ^BDGF("FO^1:"_$LENGTH(COUNT),PROMPT)
+31 ;
+32 IF Y="A"
IF $GET(BDGSVE)
DO ADD
DO PAT
QUIT
+33 IF $DATA(BDGA(+Y))
SET BDGN=BDGA(Y)
Begin DoDot:1
+34 ;edit then view
IF $GET(BDGSVE)
DO SCREEN
DO PAT
QUIT
+35 ;view only
DO ^BDGSVS
QUIT
End DoDot:1
+36 QUIT
+37 ;
+38 ;
SCREEN ; -- call ScreenMan to add/edit parameters
+1 NEW DDSFILE,DA,DR,X
+2 SET DDSFILE=9009016.7
SET DA=BDGN
+3 ;type of visit
SET X=$$GET1^DIQ(9009016.7,BDGN,.03,"I")
+4 SET DR="[BDG SCHED "_$SELECT(X="A":"ADMIT",X="D":"DAY SURGERY",1:"OUTPATIENT")_"]"
+5 DO ^DDS
+6 IF $$READ^BDGF("Y","Want to print Scheduled Visit Summary","NO")
DO ^BDGSVS
+7 QUIT
+8 ;
ADD ; add new entry then call Screenman
+1 NEW DIC,X,DA,DLAYGO
+2 SET (DIC,DLAYGO)=9009016.7
SET X=DFN
SET DIC(0)="AEMQLZ"
+3 SET DIC("DR")=".02;.03"
KILL DO,DD
DO FILE^DICN
+4 IF Y
SET BDGN=+Y
DO SCREEN
+5 QUIT
+6 ;
