- 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
