- SDAMLD ;ALB/CAW - Ambulartory Status Update Log Utilities ; 3/6/92
- ;;5.3;Scheduling;**1015**;Aug 13, 1993;Build 21
- ;
- EN D DT^DICRW S X=$T(+1),DIK="^DOPT("""_$P(X," ;",1)_""","
- G:$D(^DOPT($P(X," ;"),4)) A S ^DOPT($P(X," ;"),0)=$P(X,";",3)_"^1N^" F I=1:1 S Y=$T(@I) Q:Y="" S ^DOPT($P(X," ;"),I,0)=$P(Y,";",3,99)
- D IXALL^DIK
- A ;
- W !! S DIC="^DOPT("""_$P($T(+1)," ;")_""",",DIC(0)="IQEAM" D ^DIC Q:Y<0 D @+Y G A
- ;
- 1 ;;Update Appointment Status
- ;
- G EN^SDAMQ
- ;
- 2 ;;View Log Date (single entry)
- ;
- S SDEF="LAST"
- SELECT W !!,"Select APPOINTMENT DATE: "_$S(SDEF]"":SDEF_"// ",1:"") R SDWHEN:DTIME
- I '$T!(SDWHEN["^") G Q2
- I SDEF="",SDWHEN="" G Q2
- I SDEF]"",SDWHEN="" S SDWHEN=SDEF
- I $$UPPER^VALM1(SDWHEN)=$E("LAST",1,$L(SDWHEN)) W $E("LAST",$L(SDWHEN)+1,4) S D0=$$LAST() G SHOW:D0 W !,*7,"o update has not completed in the last 100 days" G SELECT
- ;
- S X=SDWHEN,DIC="^SDD(409.65,",DIC(0)="EMQ" D ^DIC K DIC G SELECT:Y<0 S D0=+Y
- ;
- SHOW S SDEF="",X="SDAMXLD" X ^%ZOSF("TEST") I $T W:$D(IOF) @IOF W "Appointment Status Log" K DXS D HEAD^SDAMXLD,^SDAMXLD K DXS G SELECT
- S D0=DA,DIC="^SDD(409.65," D EN^DIQ G SELECT
- Q2 K SDWHEN,SDEF,D0,Y,X,DA,DIC Q
- ;
- 3 ;;View Log Date (date range)
- ;
- N SDT00,SDBD,SDED,BEGDATE,ENDDATE,X
- S SDT00="AEX" D DATE^SDUTL G:'$D(SDED) Q3
- S L=0,FLDS="[SDAMVLD]",BY="@.01",FR=SDBD,TO=SDED
- S DHD="Appointment Status Update Log from "_$$FTIME^VALM1(BEGDATE)_" to "_$$FTIME^VALM1(ENDDATE)
- S DIC="^SDD(409.65," D EN1^DIP
- Q3 Q
- ;
- 4 ;;Purge log entries (data will be kept for current+1 FYs)
- ;
- N SDLFY,SDMAX,SDBD,SDED,BEGDATE,ENDDATE,SDLIM,SDT00,X,Y
- S SDLIM=($E(DT,1,3)-$S($E(DT,4,5)>9:1,1:2))_"1001"
- W !,"This option will not purge dates beyond " S X1=SDLIM,X2=-1 D C^%DTC S (Y,SDLFY,SDMAX)=X D DT^DIQ W "."
- S %DT(0)=-X,SDT00="AEX" D DATE^SDUTL G:'$D(SDED) Q4 S SDCNT=0
- I SDED<SDMAX S SDMAX=SDED
- S Y=$$QUE
- Q
- ;
- EN4 ;
- N DIK,SDI,DA,SDCNT
- S DIK="^SDD(409.65,",SDCNT=0
- F SDI=SDBD:0 S SDI=$O(^SDD(409.65,"B",SDI)) Q:'SDI!(SDI>SDMAX) S DA=$O(^(SDI,0)) D ^DIK S SDCNT=SDCNT+1
- D BULL
- Q4 Q
- ;
- LAST() ;
- ; input - no input (user selection of last)
- ; output - the latest date, beginning day or -100 days
- ;
- N SDI,LAST
- F SDI=0:1:100 S X1=DT,X2=-SDI D C^%DTC S LAST=$O(^SDD(409.65,"B",X,0)) S LAST1=$P($G(^SDD(409.65,+LAST,0)),U,5) Q:LAST1
- Q LAST
- BULL ; Bulletin for purge
- N SDLN,SDMSG
- K ^TMP("SDAMLBL",$J)
- S SDLN=0,XMSUB="APPOINTMENT STATUS UPDATE LOG PURGE" K XMY
- S XMTEXT="^TMP(""SDAMLBL"",$J,"
- S XMY($S(DUZ:DUZ,1:.5))=""
- S XMDUZ=.5 D NOW^%DTC
- S SDMSG=" " D SETLN
- S SDMSG="The Appointment Status Update Log Purge was completed "_$$FTIME^VALM1(%)_"." D SETLN
- S SDMSG=" " D SETLN
- S SDMSG=SDCNT_" records were purged from "_$$FDATE^VALM1(SDBD)_" to "_$$FDATE^VALM1(SDED)_"." D SETLN
- D ^XMD
- K ^TMP("SDAMLBL",$J),XMY,XMTEXT,XMSUB
- Q
- ;
- SETLN ; Setting TMP global for bulletin
- S SDLN=SDLN+1
- S ^TMP("SDAMLBL",$J,SDLN)=SDMSG
- Q
- QUE() ; -- que job
- ; return: did job que [ 1|yes 0|no ]
- ;
- K ZTSK,IO("Q")
- S ZTIO="",ZTDESC="Appointment Update Log Status Purge",ZTRTN="EN4^SDAMLD"
- F X="SDBD","SDED","SDMAX","DUZ" S ZTSAVE(X)=""
- D ^%ZTLOAD W:$D(ZTSK) " (Task: ",ZTSK,")"
- Q $D(ZTSK)
- SDAMLD ;ALB/CAW - Ambulartory Status Update Log Utilities ; 3/6/92
- +1 ;;5.3;Scheduling;**1015**;Aug 13, 1993;Build 21
- +2 ;
- EN DO DT^DICRW
- SET X=$TEXT(+1)
- SET DIK="^DOPT("""_$PIECE(X," ;",1)_""","
- +1 IF $DATA(^DOPT($PIECE(X," ;"),4))
- GOTO A
- SET ^DOPT($PIECE(X," ;"),0)=$PIECE(X,";",3)_"^1N^"
- FOR I=1:1
- SET Y=$TEXT(@I)
- IF Y=""
- QUIT
- SET ^DOPT($PIECE(X," ;"),I,0)=$PIECE(Y,";",3,99)
- +2 DO IXALL^DIK
- A ;
- +1 WRITE !!
- SET DIC="^DOPT("""_$PIECE($TEXT(+1)," ;")_""","
- SET DIC(0)="IQEAM"
- DO ^DIC
- IF Y<0
- QUIT
- DO @+Y
- GOTO A
- +2 ;
- 1 ;;Update Appointment Status
- +1 ;
- +2 GOTO EN^SDAMQ
- +3 ;
- 2 ;;View Log Date (single entry)
- +1 ;
- +2 SET SDEF="LAST"
- SELECT WRITE !!,"Select APPOINTMENT DATE: "_$SELECT(SDEF]"":SDEF_"// ",1:"")
- READ SDWHEN:DTIME
- +1 IF '$TEST!(SDWHEN["^")
- GOTO Q2
- +2 IF SDEF=""
- IF SDWHEN=""
- GOTO Q2
- +3 IF SDEF]""
- IF SDWHEN=""
- SET SDWHEN=SDEF
- +4 IF $$UPPER^VALM1(SDWHEN)=$EXTRACT("LAST",1,$LENGTH(SDWHEN))
- WRITE $EXTRACT("LAST",$LENGTH(SDWHEN)+1,4)
- SET D0=$$LAST()
- IF D0
- GOTO SHOW
- WRITE !,*7,"o update has not completed in the last 100 days"
- GOTO SELECT
- +5 ;
- +6 SET X=SDWHEN
- SET DIC="^SDD(409.65,"
- SET DIC(0)="EMQ"
- DO ^DIC
- KILL DIC
- IF Y<0
- GOTO SELECT
- SET D0=+Y
- +7 ;
- SHOW SET SDEF=""
- SET X="SDAMXLD"
- XECUTE ^%ZOSF("TEST")
- IF $TEST
- IF $DATA(IOF)
- WRITE @IOF
- WRITE "Appointment Status Log"
- KILL DXS
- DO HEAD^SDAMXLD
- DO ^SDAMXLD
- KILL DXS
- GOTO SELECT
- +1 SET D0=DA
- SET DIC="^SDD(409.65,"
- DO EN^DIQ
- GOTO SELECT
- Q2 KILL SDWHEN,SDEF,D0,Y,X,DA,DIC
- QUIT
- +1 ;
- 3 ;;View Log Date (date range)
- +1 ;
- +2 NEW SDT00,SDBD,SDED,BEGDATE,ENDDATE,X
- +3 SET SDT00="AEX"
- DO DATE^SDUTL
- IF '$DATA(SDED)
- GOTO Q3
- +4 SET L=0
- SET FLDS="[SDAMVLD]"
- SET BY="@.01"
- SET FR=SDBD
- SET TO=SDED
- +5 SET DHD="Appointment Status Update Log from "_$$FTIME^VALM1(BEGDATE)_" to "_$$FTIME^VALM1(ENDDATE)
- +6 SET DIC="^SDD(409.65,"
- DO EN1^DIP
- Q3 QUIT
- +1 ;
- 4 ;;Purge log entries (data will be kept for current+1 FYs)
- +1 ;
- +2 NEW SDLFY,SDMAX,SDBD,SDED,BEGDATE,ENDDATE,SDLIM,SDT00,X,Y
- +3 SET SDLIM=($EXTRACT(DT,1,3)-$SELECT($EXTRACT(DT,4,5)>9:1,1:2))_"1001"
- +4 WRITE !,"This option will not purge dates beyond "
- SET X1=SDLIM
- SET X2=-1
- DO C^%DTC
- SET (Y,SDLFY,SDMAX)=X
- DO DT^DIQ
- WRITE "."
- +5 SET %DT(0)=-X
- SET SDT00="AEX"
- DO DATE^SDUTL
- IF '$DATA(SDED)
- GOTO Q4
- SET SDCNT=0
- +6 IF SDED<SDMAX
- SET SDMAX=SDED
- +7 SET Y=$$QUE
- +8 QUIT
- +9 ;
- EN4 ;
- +1 NEW DIK,SDI,DA,SDCNT
- +2 SET DIK="^SDD(409.65,"
- SET SDCNT=0
- +3 FOR SDI=SDBD:0
- SET SDI=$ORDER(^SDD(409.65,"B",SDI))
- IF 'SDI!(SDI>SDMAX)
- QUIT
- SET DA=$ORDER(^(SDI,0))
- DO ^DIK
- SET SDCNT=SDCNT+1
- +4 DO BULL
- Q4 QUIT
- +1 ;
- LAST() ;
- +1 ; input - no input (user selection of last)
- +2 ; output - the latest date, beginning day or -100 days
- +3 ;
- +4 NEW SDI,LAST
- +5 FOR SDI=0:1:100
- SET X1=DT
- SET X2=-SDI
- DO C^%DTC
- SET LAST=$ORDER(^SDD(409.65,"B",X,0))
- SET LAST1=$PIECE($GET(^SDD(409.65,+LAST,0)),U,5)
- IF LAST1
- QUIT
- +6 QUIT LAST
- BULL ; Bulletin for purge
- +1 NEW SDLN,SDMSG
- +2 KILL ^TMP("SDAMLBL",$JOB)
- +3 SET SDLN=0
- SET XMSUB="APPOINTMENT STATUS UPDATE LOG PURGE"
- KILL XMY
- +4 SET XMTEXT="^TMP(""SDAMLBL"",$J,"
- +5 SET XMY($SELECT(DUZ:DUZ,1:.5))=""
- +6 SET XMDUZ=.5
- DO NOW^%DTC
- +7 SET SDMSG=" "
- DO SETLN
- +8 SET SDMSG="The Appointment Status Update Log Purge was completed "_$$FTIME^VALM1(%)_"."
- DO SETLN
- +9 SET SDMSG=" "
- DO SETLN
- +10 SET SDMSG=SDCNT_" records were purged from "_$$FDATE^VALM1(SDBD)_" to "_$$FDATE^VALM1(SDED)_"."
- DO SETLN
- +11 DO ^XMD
- +12 KILL ^TMP("SDAMLBL",$JOB),XMY,XMTEXT,XMSUB
- +13 QUIT
- +14 ;
- SETLN ; Setting TMP global for bulletin
- +1 SET SDLN=SDLN+1
- +2 SET ^TMP("SDAMLBL",$JOB,SDLN)=SDMSG
- +3 QUIT
- QUE() ; -- que job
- +1 ; return: did job que [ 1|yes 0|no ]
- +2 ;
- +3 KILL ZTSK,IO("Q")
- +4 SET ZTIO=""
- SET ZTDESC="Appointment Update Log Status Purge"
- SET ZTRTN="EN4^SDAMLD"
- +5 FOR X="SDBD","SDED","SDMAX","DUZ"
- SET ZTSAVE(X)=""
- +6 DO ^%ZTLOAD
- IF $DATA(ZTSK)
- WRITE " (Task: ",ZTSK,")"
- +7 QUIT $DATA(ZTSK)
