- SDWARD ;ALB/GRR - LIST INPATIENTS WITH PENDING APPTS ; 14 NOV 84
- ;;5.3;Scheduling;**406**;Aug 13, 1993
- S %DT(0)=-DT,%DT="AXE",%DT("A")="LIST PATIENTS WITH PENDING APPOINTMENTS ADMITTED ON DATE: " D ^%DT K %DT Q:Y<0 S SDY=Y D:'$D(DT) DT^SDUTL
- S VAR="SDY",VAL=SDY,PGM="START^SDWARD" D ZIS^DGUTQ G:POP END
- ;
- START K ^UTILITY("SD",$J),^TMP($J,"SDAMA301") U IO S Y=SDY D D^DIQ S SDPY=Y,Y=DT D D^DIQ S HY=Y
- N SDLIST,SDCOUNT S SDCOUNT=0
- F SDJ=SDY-.0001:0 S SDJ=$O(^DGPM("AMV1",SDJ)) Q:SDJ=""!(SDJ\1>SDY)!$D(SDERR) F DFN=0:0 S DFN=$O(^DGPM("AMV1",SDJ,DFN)) Q:DFN="" S SDLIST(DFN)=""
- I $D(SDLIST)>1 D CHECK
- I SDCOUNT<0 W !,$$SDAPIERR^SDAMUTDT D END Q ; SDAPI Returned an Error.
- I '$D(^UTILITY("SD",$J)) W !,"NO PATIENTS FOUND" G END
- D HED
- S SDD=0 F SD=0:0 S SDD=$O(^UTILITY("SD",$J,SDD)) Q:SDD="" S DFN=$O(^UTILITY("SD",$J,SDD,0)) D PN F SDI=0:0 S SDI=$O(^UTILITY("SD",$J,SDD,DFN,SDI)) Q:SDI="" F SC=0:0 S SC=$O(^UTILITY("SD",$J,SDD,DFN,SDI,SC)) Q:SC="" D PRT
- G END
- ;
- CHECK N SDARRAY,SDDATE,SDDATA,SDNAME,SDCLIN,SDDFN
- S SDARRAY(1)=DT,SDARRAY(3)="R;I",SDARRAY(4)="SDLIST(",SDARRAY("FLDS")="2;4",SDARRAY("SORT")="P"
- S SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY) Q:SDCOUNT'>0
- S SDDFN="" F S SDDFN=$O(^TMP($J,"SDAMA301",SDDFN)) Q:SDDFN="" D
- . S SDDATE="" F S SDDATE=$O(^TMP($J,"SDAMA301",SDDFN,SDDATE)) Q:SDDATE="" S SDDATA=$G(^(SDDATE)) D
- ..S SDNAME=$P($P(SDDATA,U,4),";",2),SDCLIN=$P($P(SDDATA,U,2),";",1)
- ..I $G(SDNAME)]"",$G(SDCLIN)]"" S ^UTILITY("SD",$J,SDNAME,SDDFN,SDDATE,SDCLIN)=""
- Q
- ;
- PRT D:$Y+2>IOSL HED
- W !,?3,$S($D(^SC(SC,0)):$P(^(0),"^",1),1:"DELETED CLINIC")
- S Y=SDI\1 D D^DIQ W ?50,Y," " S X=SDI D TM^SDROUT0 W ?61,$J(X,8)
- Q
- ;
- PN D:$Y+2>IOSL HED
- D PID^VADPT6 W !,$E($P(^DPT(DFN,0),"^",1),1,25),?29,VA("PID") K VA("BID"),VA("PID") I $D(^DPT(DFN,.1)) W ?43,$P(^(.1),"^",1)
- Q
- ;
- HED W @IOF,!,"PATIENTS ADMITTED ",SDPY," WHO HAVE PENDING APPOINTMENTS",?66,HY,!,"PATIENT NAME",?32,"PT ID",?43,"WARD"
- W !,?3,"CLINIC",?50,"APPNT DATE",?64,"TIME",! F I=1:1:79 W "-"
- Q
- ;
- END W !,@IOF K %DT,DFN,I,HY,SC,SD,SDD,SDI,SDJ,SDPY,SDY,X,Y,SDERR,PGM,POP,VA,VAL,VAR,^UTILITY("SD")
- K ^TMP($J,"SDAMA301")
- D CLOSE^DGUTQ,SDWARD^SDKILL
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDWARD 2191 printed Feb 19, 2025@00:28:35 Page 2
- SDWARD ;ALB/GRR - LIST INPATIENTS WITH PENDING APPTS ; 14 NOV 84
- +1 ;;5.3;Scheduling;**406**;Aug 13, 1993
- +2 SET %DT(0)=-DT
- SET %DT="AXE"
- SET %DT("A")="LIST PATIENTS WITH PENDING APPOINTMENTS ADMITTED ON DATE: "
- DO ^%DT
- KILL %DT
- if Y<0
- QUIT
- SET SDY=Y
- if '$DATA(DT)
- DO DT^SDUTL
- +3 SET VAR="SDY"
- SET VAL=SDY
- SET PGM="START^SDWARD"
- DO ZIS^DGUTQ
- if POP
- GOTO END
- +4 ;
- START KILL ^UTILITY("SD",$JOB),^TMP($JOB,"SDAMA301")
- USE IO
- SET Y=SDY
- DO D^DIQ
- SET SDPY=Y
- SET Y=DT
- DO D^DIQ
- SET HY=Y
- +1 NEW SDLIST,SDCOUNT
- SET SDCOUNT=0
- +2 FOR SDJ=SDY-.0001:0
- SET SDJ=$ORDER(^DGPM("AMV1",SDJ))
- if SDJ=""!(SDJ\1>SDY)!$DATA(SDERR)
- QUIT
- FOR DFN=0:0
- SET DFN=$ORDER(^DGPM("AMV1",SDJ,DFN))
- if DFN=""
- QUIT
- SET SDLIST(DFN)=""
- +3 IF $DATA(SDLIST)>1
- DO CHECK
- +4 ; SDAPI Returned an Error.
- IF SDCOUNT<0
- WRITE !,$$SDAPIERR^SDAMUTDT
- DO END
- QUIT
- +5 IF '$DATA(^UTILITY("SD",$JOB))
- WRITE !,"NO PATIENTS FOUND"
- GOTO END
- +6 DO HED
- +7 SET SDD=0
- FOR SD=0:0
- SET SDD=$ORDER(^UTILITY("SD",$JOB,SDD))
- if SDD=""
- QUIT
- SET DFN=$ORDER(^UTILITY("SD",$JOB,SDD,0))
- DO PN
- FOR SDI=0:0
- SET SDI=$ORDER(^UTILITY("SD",$JOB,SDD,DFN,SDI))
- if SDI=""
- QUIT
- FOR SC=0:0
- SET SC=$ORDER(^UTILITY("SD",$JOB,SDD,DFN,SDI,SC))
- if SC=""
- QUIT
- DO PRT
- +8 GOTO END
- +9 ;
- CHECK NEW SDARRAY,SDDATE,SDDATA,SDNAME,SDCLIN,SDDFN
- +1 SET SDARRAY(1)=DT
- SET SDARRAY(3)="R;I"
- SET SDARRAY(4)="SDLIST("
- SET SDARRAY("FLDS")="2;4"
- SET SDARRAY("SORT")="P"
- +2 SET SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY)
- if SDCOUNT'>0
- QUIT
- +3 SET SDDFN=""
- FOR
- SET SDDFN=$ORDER(^TMP($JOB,"SDAMA301",SDDFN))
- if SDDFN=""
- QUIT
- Begin DoDot:1
- +4 SET SDDATE=""
- FOR
- SET SDDATE=$ORDER(^TMP($JOB,"SDAMA301",SDDFN,SDDATE))
- if SDDATE=""
- QUIT
- SET SDDATA=$GET(^(SDDATE))
- Begin DoDot:2
- +5 SET SDNAME=$PIECE($PIECE(SDDATA,U,4),";",2)
- SET SDCLIN=$PIECE($PIECE(SDDATA,U,2),";",1)
- +6 IF $GET(SDNAME)]""
- IF $GET(SDCLIN)]""
- SET ^UTILITY("SD",$JOB,SDNAME,SDDFN,SDDATE,SDCLIN)=""
- End DoDot:2
- End DoDot:1
- +7 QUIT
- +8 ;
- PRT if $Y+2>IOSL
- DO HED
- +1 WRITE !,?3,$SELECT($DATA(^SC(SC,0)):$PIECE(^(0),"^",1),1:"DELETED CLINIC")
- +2 SET Y=SDI\1
- DO D^DIQ
- WRITE ?50,Y," "
- SET X=SDI
- DO TM^SDROUT0
- WRITE ?61,$JUSTIFY(X,8)
- +3 QUIT
- +4 ;
- PN if $Y+2>IOSL
- DO HED
- +1 DO PID^VADPT6
- WRITE !,$EXTRACT($PIECE(^DPT(DFN,0),"^",1),1,25),?29,VA("PID")
- KILL VA("BID"),VA("PID")
- IF $DATA(^DPT(DFN,.1))
- WRITE ?43,$PIECE(^(.1),"^",1)
- +2 QUIT
- +3 ;
- HED WRITE @IOF,!,"PATIENTS ADMITTED ",SDPY," WHO HAVE PENDING APPOINTMENTS",?66,HY,!,"PATIENT NAME",?32,"PT ID",?43,"WARD"
- +1 WRITE !,?3,"CLINIC",?50,"APPNT DATE",?64,"TIME",!
- FOR I=1:1:79
- WRITE "-"
- +2 QUIT
- +3 ;
- END WRITE !,@IOF
- KILL %DT,DFN,I,HY,SC,SD,SDD,SDI,SDJ,SDPY,SDY,X,Y,SDERR,PGM,POP,VA,VAL,VAR,^UTILITY("SD")
- +1 KILL ^TMP($JOB,"SDAMA301")
- +2 DO CLOSE^DGUTQ
- DO SDWARD^SDKILL
- +3 QUIT
