- SDWLE112 ;;IOFO BAY PINES/TEH - WAITING LIST-ENTER/EDIT;06/12/2002 ; 20 Aug 2002 2:10 PM
- ;;5.3;scheduling;**263,273,1015**;AUG 13 1993;Build 21
- ;
- ;
- ;******************************************************************
- ; CHANGE LOG
- ;
- ; DATE PATCH DESCRIPTION
- ; ---- ----- -----------
- ; 11/27/02 SD*5.3*273 Add "/" to line EN+14
- ;
- ;
- ;
- EN ;
- ;Set record status to 'OPEN'
- ;
- S DR="23///^S X=""O""",DIE="^SDWL(409.3," D ^DIE
- ;
- ;Ask comments
- ;
- S DIR(0)="FAOU^^",DIR("A")="Comments: " D ^DIR
- I Y["^" S SDWLERR=2 Q
- S DR="25////^S X=SDWLCOME " D ^DIE
- ;
- ;
- ;Set Editing User
- ;
- S DR="28////^S X=DUZ",DIE="^SDWL(409.3," D ^DIE
- ;
- S SDWLERR=0 Q
- Q
- END K SDWLCN,SDWLCN,SDWLPS,SDWLY,SDWLNEW,SDWLSSN,SDWLNAM,SDWLDATA,SDWLIN,SDWLCL,SDWLTY,SDWLST,SDWLSP,SDWLSS
- K SDWLSC,SDWLPRI,SDWLRB,SDWLPROV,SDWLDAPT,SDWLST,SDWLCOM,SDWLDUZ,SDWLEDT,SDCL,SDWLTYE,SDWLINE,SDWLS,SDWLX,SDWLPRIE,SDWLPRVE
- K SDWLDAPE,SDWLRBE,SDWL,VA,VADM,VAIN,D0,DA,DI,DIC,DIE,DQ,DR,SDWLCLN,SDWLCNT,SDWLDIS,SDWLDISN,SDWLDT,SDWLDTP,SDWLINN,SDWLPRIN,SDWLTYN
- K SDWLWR,VAERR,YY,MM,DD,SDWLSCP,SDWLVAR,SDWLF,SDWLSX,SDWLCP1,SCWLCP2,SDWLCP2,SDWLCP3,SDWLCP4,SDWLCP5,SDWLCP6,E,SDWLCOME,SDWLDFN,SDWLPCMM
- K DIR
- I $D(SDWLDA),$D(^SDWL(409.3,SDWLDA,0)),$P(^SDWL(409.3,SDWLDA,0),U,17)'["O" D
- .W !!,?15,"*** Patient being Removed from Wait List ***" S DIK="^SDWL(409.3,",DA=SDWLDA D ^DIK
- K SDWLDA
- Q
- SDWLE112 ;;IOFO BAY PINES/TEH - WAITING LIST-ENTER/EDIT;06/12/2002 ; 20 Aug 2002 2:10 PM
- +1 ;;5.3;scheduling;**263,273,1015**;AUG 13 1993;Build 21
- +2 ;
- +3 ;
- +4 ;******************************************************************
- +5 ; CHANGE LOG
- +6 ;
- +7 ; DATE PATCH DESCRIPTION
- +8 ; ---- ----- -----------
- +9 ; 11/27/02 SD*5.3*273 Add "/" to line EN+14
- +10 ;
- +11 ;
- +12 ;
- EN ;
- +1 ;Set record status to 'OPEN'
- +2 ;
- +3 SET DR="23///^S X=""O"""
- SET DIE="^SDWL(409.3,"
- DO ^DIE
- +4 ;
- +5 ;Ask comments
- +6 ;
- +7 SET DIR(0)="FAOU^^"
- SET DIR("A")="Comments: "
- DO ^DIR
- +8 IF Y["^"
- SET SDWLERR=2
- QUIT
- +9 SET DR="25////^S X=SDWLCOME "
- DO ^DIE
- +10 ;
- +11 ;
- +12 ;Set Editing User
- +13 ;
- +14 SET DR="28////^S X=DUZ"
- SET DIE="^SDWL(409.3,"
- DO ^DIE
- +15 ;
- +16 SET SDWLERR=0
- QUIT
- +17 QUIT
- END KILL SDWLCN,SDWLCN,SDWLPS,SDWLY,SDWLNEW,SDWLSSN,SDWLNAM,SDWLDATA,SDWLIN,SDWLCL,SDWLTY,SDWLST,SDWLSP,SDWLSS
- +1 KILL SDWLSC,SDWLPRI,SDWLRB,SDWLPROV,SDWLDAPT,SDWLST,SDWLCOM,SDWLDUZ,SDWLEDT,SDCL,SDWLTYE,SDWLINE,SDWLS,SDWLX,SDWLPRIE,SDWLPRVE
- +2 KILL SDWLDAPE,SDWLRBE,SDWL,VA,VADM,VAIN,D0,DA,DI,DIC,DIE,DQ,DR,SDWLCLN,SDWLCNT,SDWLDIS,SDWLDISN,SDWLDT,SDWLDTP,SDWLINN,SDWLPRIN,SDWLTYN
- +3 KILL SDWLWR,VAERR,YY,MM,DD,SDWLSCP,SDWLVAR,SDWLF,SDWLSX,SDWLCP1,SCWLCP2,SDWLCP2,SDWLCP3,SDWLCP4,SDWLCP5,SDWLCP6,E,SDWLCOME,SDWLDFN,SDWLPCMM
- +4 KILL DIR
- +5 IF $DATA(SDWLDA)
- IF $DATA(^SDWL(409.3,SDWLDA,0))
- IF $PIECE(^SDWL(409.3,SDWLDA,0),U,17)'["O"
- Begin DoDot:1
- +6 WRITE !!,?15,"*** Patient being Removed from Wait List ***"
- SET DIK="^SDWL(409.3,"
- SET DA=SDWLDA
- DO ^DIK
- End DoDot:1
- +7 KILL SDWLDA
- +8 QUIT