ASDHS ; IHS/ADC/PDW/ENM - HS BY CLINIC ; [ 03/25/1999 11:48 AM ]
;;5.0;IHS SCHEDULING;;MAR 25, 1999
;
S DIV="" D DIV^SDUTL I $T D ROUT^SDDIV G:Y<0 END
S (SDIQ,SDX,SDREP,SDSTART)="",SDX="ALL"
;
SORT ; -- ask user for sort option
S ORDER=0
K DIR S DIR(0)="SAO^C:CLINIC;P:PRINCIPLE CLINIC",DIR("B")="P"
S DIR("A")="PRINT IN (C)LINIC or (P)RINCIPLE CLINIC ORDER: "
S DIR("?",1)="Answer C - To see health summaries printed by clinic"
S DIR("?",2)="Answer P - To sort them by principle clinic"
S DIR("?")=" "
D ^DIR K DIR G END:$D(DIRUT) S ORDER=$S(Y="C":2,1:3)
;
S VAUTD=$S(DIV="":1,1:DIV)
S VAUTNI=1 D CLINIC^VAUTOMA G:Y<0 END
D:'$D(DT) DT^SDUTL
S %DT="AEXF",%DT("A")="PRINT HEALTH SUMMARIES FOR WHAT DATE: "
D ^%DT K %DT("A") G:Y<1 END S SDATE=Y
;
K DIR S DIR(0)="YO",DIR("B")="YES"
S DIR("A")="Do you want to print other forms also"
S DIR("?",1)="Answer YES to print not only Health Summaries but"
S DIR("?",2)="also Address/Insurance Updates, Medication Profiles"
S DIR("?",3)="and Encounter forms if the clinic(s) have asked for"
S DIR("?",4)="them in their setup."
S DIR("?",5)="Answer NO to print ONLY Health Summaries."
S DIR("?")=" " D ^DIR G END:$D(DIRUT)
I Y'=1 S (SDZEF,SDZMP,SDZAI)=1
;
A5 ;
S VAR="VAUTD#^VAUTC#^DIV^SDX^ORDER^SDATE^SDIQ^SDREP^SDSTART^SDZEF^SDZMP^SDZAIU"
S DGPGM="START^ASDHS"
S ADGDEV=$$VAL^XBDIQ1(40.8,$$DIV^ASDUT,9999999.06)
I ADGDEV="" K ADGDEV
D ZIS^DGUTQ G:POP END^SDROUT1
G START:'$D(IO("Q"))
;
END ; -- eoj
K ALL,DIV,ORD,ORDER,RMSEL,SDIQ,SDREP,SDSP,SDSTART
K SDX,X,Y,C,V,I,SDEF,%I Q
;
START ;EP; loop thru clinics and appts to get patients
NEW ASDX,ASDY,ASDT
K ^UTILITY("SDHS",$J) U IO
;
I ORDER=2,'$G(VAUTC) D CLIN Q
;
S ASDX=0
F S ASDX=$O(^SC(ASDX)) Q:'ASDX D CHECK I $T D
. I '$G(VAUTC) D CHECK2 Q:'$T
. S ASDT=SDATE
. F S ASDT=$O(^SC(ASDX,"S",ASDT)) Q:ASDT=""!(ASDT>(SDATE+1)) D
.. S ASDY=0 F S ASDY=$O(^SC(ASDX,"S",ASDT,1,ASDY)) Q:'ASDY D
... I $P($G(^SC(ASDX,"S",ASDT,1,ASDY,0)),U,9)'="C" D GOT^ASDHS1
D GO^ASDHS1 K VAUTC,VAUTD,SDZEF,SDZMP,SDZAI Q
;
CLIN ; -- sorts by clinic
S ASDZ=""
F S ASDZ=$O(VAUTC(ASDZ)) Q:ASDZ="" D
. S ASDX=+VAUTC(ASDZ) D CHECK I $T D
.. S ASDT=SDATE
.. F S ASDT=$O(^SC(ASDX,"S",ASDT)) Q:ASDT=""!(ASDT>(SDATE+1)) D
... S ASDY=0 F S ASDY=$O(^SC(ASDX,"S",ASDT,1,ASDY)) Q:'ASDY D
.... I $P($G(^SC(ASDX,"S",ASDT,1,ASDY,0)),U,9)'="C" D GOT^ASDHS1
D GO^ASDHS1 K VAUTC,VAUTD,SDZEF,SDZMP,SDZAI Q
;
CHECK ; -- checks out clinic (active?, in division?, etc.)
I $P(^SC(ASDX,0),U,3)="C",$S(DIV="":1,$P(^SC(ASDX,0),U,15)=DIV:1,1:0),$S('$D(^SC(ASDX,"I")):1,+^("I")=0:1,+^("I")>SDATE:1,+$P(^("I"),U,2)'>SDATE&(+$P(^("I"),U,2)):1,1:0)
Q
;
CHECK2 ; -- checks if clinic belongs to prin clinic chosen
NEW X
S X=$P($G(^SC(ASDX,"SL")),U,5)
I X]"",$D(VAUTC($P(^SC(+X,0),U)))
Q
ASDHS ; IHS/ADC/PDW/ENM - HS BY CLINIC ; [ 03/25/1999 11:48 AM ]
+1 ;;5.0;IHS SCHEDULING;;MAR 25, 1999
+2 ;
+3 SET DIV=""
DO DIV^SDUTL
IF $TEST
DO ROUT^SDDIV
IF Y<0
GOTO END
+4 SET (SDIQ,SDX,SDREP,SDSTART)=""
SET SDX="ALL"
+5 ;
SORT ; -- ask user for sort option
+1 SET ORDER=0
+2 KILL DIR
SET DIR(0)="SAO^C:CLINIC;P:PRINCIPLE CLINIC"
SET DIR("B")="P"
+3 SET DIR("A")="PRINT IN (C)LINIC or (P)RINCIPLE CLINIC ORDER: "
+4 SET DIR("?",1)="Answer C - To see health summaries printed by clinic"
+5 SET DIR("?",2)="Answer P - To sort them by principle clinic"
+6 SET DIR("?")=" "
+7 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
GOTO END
SET ORDER=$SELECT(Y="C":2,1:3)
+8 ;
+9 SET VAUTD=$SELECT(DIV="":1,1:DIV)
+10 SET VAUTNI=1
DO CLINIC^VAUTOMA
IF Y<0
GOTO END
+11 IF '$DATA(DT)
DO DT^SDUTL
+12 SET %DT="AEXF"
SET %DT("A")="PRINT HEALTH SUMMARIES FOR WHAT DATE: "
+13 DO ^%DT
KILL %DT("A")
IF Y<1
GOTO END
SET SDATE=Y
+14 ;
+15 KILL DIR
SET DIR(0)="YO"
SET DIR("B")="YES"
+16 SET DIR("A")="Do you want to print other forms also"
+17 SET DIR("?",1)="Answer YES to print not only Health Summaries but"
+18 SET DIR("?",2)="also Address/Insurance Updates, Medication Profiles"
+19 SET DIR("?",3)="and Encounter forms if the clinic(s) have asked for"
+20 SET DIR("?",4)="them in their setup."
+21 SET DIR("?",5)="Answer NO to print ONLY Health Summaries."
+22 SET DIR("?")=" "
DO ^DIR
IF $DATA(DIRUT)
GOTO END
+23 IF Y'=1
SET (SDZEF,SDZMP,SDZAI)=1
+24 ;
A5 ;
+1 SET VAR="VAUTD#^VAUTC#^DIV^SDX^ORDER^SDATE^SDIQ^SDREP^SDSTART^SDZEF^SDZMP^SDZAIU"
+2 SET DGPGM="START^ASDHS"
+3 SET ADGDEV=$$VAL^XBDIQ1(40.8,$$DIV^ASDUT,9999999.06)
+4 IF ADGDEV=""
KILL ADGDEV
+5 DO ZIS^DGUTQ
IF POP
GOTO END^SDROUT1
+6 IF '$DATA(IO("Q"))
GOTO START
+7 ;
END ; -- eoj
+1 KILL ALL,DIV,ORD,ORDER,RMSEL,SDIQ,SDREP,SDSP,SDSTART
+2 KILL SDX,X,Y,C,V,I,SDEF,%I
QUIT
+3 ;
START ;EP; loop thru clinics and appts to get patients
+1 NEW ASDX,ASDY,ASDT
+2 KILL ^UTILITY("SDHS",$JOB)
USE IO
+3 ;
+4 IF ORDER=2
IF '$GET(VAUTC)
DO CLIN
QUIT
+5 ;
+6 SET ASDX=0
+7 FOR
SET ASDX=$ORDER(^SC(ASDX))
IF 'ASDX
QUIT
DO CHECK
IF $TEST
Begin DoDot:1
+8 IF '$GET(VAUTC)
DO CHECK2
IF '$TEST
QUIT
+9 SET ASDT=SDATE
+10 FOR
SET ASDT=$ORDER(^SC(ASDX,"S",ASDT))
IF ASDT=""!(ASDT>(SDATE+1))
QUIT
Begin DoDot:2
+11 SET ASDY=0
FOR
SET ASDY=$ORDER(^SC(ASDX,"S",ASDT,1,ASDY))
IF 'ASDY
QUIT
Begin DoDot:3
+12 IF $PIECE($GET(^SC(ASDX,"S",ASDT,1,ASDY,0)),U,9)'="C"
DO GOT^ASDHS1
End DoDot:3
End DoDot:2
End DoDot:1
+13 DO GO^ASDHS1
KILL VAUTC,VAUTD,SDZEF,SDZMP,SDZAI
QUIT
+14 ;
CLIN ; -- sorts by clinic
+1 SET ASDZ=""
+2 FOR
SET ASDZ=$ORDER(VAUTC(ASDZ))
IF ASDZ=""
QUIT
Begin DoDot:1
+3 SET ASDX=+VAUTC(ASDZ)
DO CHECK
IF $TEST
Begin DoDot:2
+4 SET ASDT=SDATE
+5 FOR
SET ASDT=$ORDER(^SC(ASDX,"S",ASDT))
IF ASDT=""!(ASDT>(SDATE+1))
QUIT
Begin DoDot:3
+6 SET ASDY=0
FOR
SET ASDY=$ORDER(^SC(ASDX,"S",ASDT,1,ASDY))
IF 'ASDY
QUIT
Begin DoDot:4
+7 IF $PIECE($GET(^SC(ASDX,"S",ASDT,1,ASDY,0)),U,9)'="C"
DO GOT^ASDHS1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+8 DO GO^ASDHS1
KILL VAUTC,VAUTD,SDZEF,SDZMP,SDZAI
QUIT
+9 ;
CHECK ; -- checks out clinic (active?, in division?, etc.)
+1 IF $PIECE(^SC(ASDX,0),U,3)="C"
IF $SELECT(DIV="":1,$PIECE(^SC(ASDX,0),U,15)=DIV:1,1:0)
IF $SELECT('$DATA(^SC(ASDX,"I")):1,+^("I")=0:1,+^("I")>SDATE:1,+$PIECE(^("I"),U,2)'>SDATE&(+$PIECE(^("I"),U,2)):1,1:0)
+2 QUIT
+3 ;
CHECK2 ; -- checks if clinic belongs to prin clinic chosen
+1 NEW X
+2 SET X=$PIECE($GET(^SC(ASDX,"SL")),U,5)
+3 IF X]""
IF $DATA(VAUTC($PIECE(^SC(+X,0),U)))
+4 QUIT
