- SDLT ;ALB/LDB,GXT - CANCELLATION LETTERS ;17 JUL 2018
- ;;5.3;Scheduling;**185,213,281,330,398,523,441,555,622,641,680,705**;Aug 13, 1993;Build 11
- ;;PER VHA DIRECTIVE 2004-038, DO NOT MODIFY THIS ROUTINE
- ;
- ;**************************************************************************
- ; MODIFICATIONS
- ;
- ; DATE PATCH DEVELOPER DESCRIPTION OF CHANGES
- ; -------- ---------- --------- ----------------------------------------
- ; 02/14/03 SD*5.3*281 SAUNDERS Print letters to confidential address if
- ; requested
- ; 12/2/03 SD*5.3*330 LUNDEN Remove form feed from PRT+0
- ; 01/21/16 SD*5.3*641 HSI Print 1st piece of 99 node
- ; 11/27/17 SD*5.3*680 JACKSON Remove gender implications
- ; 06/13/18 SD*5.3*705 THOMAS Add blank line between appointments in
- ; letters
- ;**************************************************************************
- ;
- N Z0,X
- ;WRITE GREETING AND OPENING TEXT OF LETTER
- PRT S DFN=$P(A,U,1) ;SD*523
- I $D(SDNOSH) I $D(^DPT(DFN,.1)) S POP=1 Q:POP ;SD/523
- S Y=DT D DTS^SDUTL
- I +$G(SDFIRST)=0 W @IOF ;SD*5.3*330 Form feed only after letter #1
- K SDFIRST
- ;S SDFIRST=0
- W !,?65,Y,!,?65,$$LAST4(A),!!!!
- I 'SDFORM W !!!!! D ADDR W !!!!
- W1 W !,"Dear " ;,$S($P(^DPT(+A,0),"^",2)="M":"Mr. ",1:"Ms. ") SD*5.3*680
- N DPTNAME
- S DPTNAME("FILE")=2,DPTNAME("FIELD")=".01",DPTNAME("IENS")=(+A)_","
- S X=$$NAMEFMT^XLFNAME(.DPTNAME,"G","M") W X,","
- W !! K ^UTILITY($J,"W"),DIWF,DIWR,DIWF S DIWL=1,DIWF="C80WN" F Z0=0:0 S Z0=$O(^VA(407.5,SDLET,1,Z0)) Q:Z0'>0 S X=^(Z0,0) D ^DIWP
- D ^DIWW K ^UTILITY($J,"W") Q
- WRAPP ;WRITE APPOINTMENT INFORMATION
- N B
- ; SD*5.3*622 - re-arrange display of clinic name
- ;S:$D(SC)&'$D(SDC) SDC=SC S SDCL=$P(^SC(+SDC,0),"^",1),SDCL=SDCL_" Clinic" D FORM
- S:$D(SC)&'$D(SDC) SDC=SC S SDCL=$P(^SC(+SDC,0),"^",1),SDCL=" Clinic: "_SDCL D FORM ; SD*5.3*622 end changes
- ;
- S SDX1=$S($D(SDX):SDX,1:X) S:$D(SDS) S=SDS F B=3,4,5 I $P(S,"^",B)]"" S SDCL=$S(B=3:"LAB",B=4:"XRAY",1:"EKG"),SDX=$P(S,"^",B) D FORM
- S (SDX,X)=SDX1 Q
- ; SD*5.3*622 - add more detail for appointment and format it
- FORM S:$D(SDX) X=SDX S SDHX=X D DW^%DTC S DOW=X,X=SDHX X ^DD("FUNC",2,1) S SDT0=X,SDDAT=$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",$E(SDHX,4,5))_" "_+$E(SDHX,6,7)_", "_(1700+$E(SDHX,1,3))
- ; Add blank line between appointments in letters - Done with patch SD*5.3*705
- I $$ADLIN,'$D(B) W !
- W:'$D(B) !?5,"Date/Time: ",?17,DOW,?$L(DOW)+19,$J(SDDAT,12)
- I '$D(B),$D(SDC) W ?22,$J(SDT0,9),!?5,SDCL
- ; get default provider if defined for a given clinic, print it on the
- ; letter only if we have a YES on file, same for clinic location
- ; skip printing the provider label if the field is empty in file #44
- N J,SDLOC,SDPROV,SDPRNM,SDTEL,SDTELEXT
- S SDLOC=$P($G(^SC(+SDC,0)),"^",11) ; physical location of the clinic
- S SDTEL=$G(^SC(+SDC,99)) ; telephone number of clinic
- S SDTELEXT="" I SDTEL]"",$G(^SC(+SDC,99.1))]"" D
- .S SDTELEXT=^SC(+SDC,99.1) ; telephone ext of clinic
- ; get default provider, if any
- F J=0:0 S J=$O(^SC(+SDC,"PR",J)) Q:'J>0 I $P($G(^SC(+SDC,"PR",J,0)),U,2)=1 S SDPROV=+$P(^SC(+SDC,"PR",J,0),U,1)
- I $D(SDC),'$D(B),$P($G(^VA(407.5,SDLET,3)),U,2)="Y" D
- .W:SDLOC]"" !?6,"Location: "_SDLOC
- I $D(SDC),'$D(B),SDTEL]"" D
- .W !?5,"Telephone: ",$P(SDTEL,U)
- .W:SDTELEXT]"" " Telephone Ext.: ",SDTELEXT
- I $D(SDPROV) D
- .I $D(SDC),SDPROV>0 S SDPRNM=$P(^VA(200,SDPROV,0),U,1)
- .I $D(SDC),'$D(B),$P($G(^VA(407.5,SDLET,3)),U,1)="Y" W:SDPRNM]"" !?6,"Provider: "_$G(SDPRNM)
- ; call handler for LAB, XRAY, and EKG tests
- I $D(B) D TST
- I $D(SDLT)&($Y>(IOSL-8)) W @IOF
- ; SD*5.3*622 end changes
- Q
- REST ;WRITE THE REMAINDER OF LETTER
- N Z5,I,X
- I SDLET W !?12 K ^UTILITY($J,"W"),DIWL,DIWR,DIWF S DIWL=1,DIWF="C80WN" F Z5=0:0 S Z5=$O(^VA(407.5,SDLET,2,Z5)) Q:Z5'>0 S X=^(Z5,0) D ^DIWP
- D ^DIWW K ^UTILITY($J,"W") Q:'SDFORM
- F I=$Y:1:IOSL-12 W !
- D ADDR Q
- ADDR K VAHOW S DFN=+A W !?12,$$FML^DGNFUNC(DFN)
- I $D(^DG(43,1,"BT")),'$P(^("BT"),"^",3) S VAPA("P")=""
- S X1=DT,X2=5 D C^%DTC I '$D(VAPA("P")) S (VATEST("ADD",9),VATEST("ADD",10))=X
- D ADD^VADPT D
- .;CHANGE STATE TO ABBR.
- .N SDIENS,X
- .I $D(VAPA(5)) S SDIENS=+VAPA(5)_",",X=$$GET1^DIQ(5,SDIENS,1),$P(VAPA(5),U,2)=X
- .I $D(VAPA(17)) S SDIENS=+VAPA(17)_",",X=$$GET1^DIQ(5,SDIENS,1),$P(VAPA(17),U,2)=X
- .K SDIENS Q
- N SDCCACT1,SDCCACT2,LL
- S SDCCACT1=VAPA(12),SDCCACT2=$P($G(VAPA(22,2)),"^",3)
- ;if confidential address is not active for scheduling/appointment letters, print to regular address
- I ($G(SDCCACT1)=0)!($G(SDCCACT2)'="Y") D
- .F LL=1:1:3 W:VAPA(LL)]"" !,?12,VAPA(LL)
- .;if country is blank display as USA
- .I (VAPA(25)="")!($P(VAPA(25),"^",2)="UNITED STATES") D ;display city,state,zip
- ..W !,?12,VAPA(4)_" "_$P(VAPA(5),U,2)_" "_$P(VAPA(11),U,2)
- .E D ;display postal code,city,province
- ..W !,?12,VAPA(24)_" "_VAPA(4)_" "_VAPA(23)
- .W:($P(VAPA(25),"^",2)'="UNITED STATES") !,?12,$P(VAPA(25),U,2) ;display country
- ;if confidential address is active for scheduling/appointment letters, print to confidential address
- I $G(SDCCACT1)=1,$G(SDCCACT2)="Y" D
- .F LL=13:1:15 W:VAPA(LL)]"" !,?12,VAPA(LL)
- .I (VAPA(28)="")!($P(VAPA(28),"^",2)="UNITED STATES") D
- ..W !,?12,VAPA(16)_" "_$P(VAPA(17),U,2)_" "_$P(VAPA(18),U,2)
- .E D
- ..W !,?12,VAPA(27)_" "_VAPA(16)_" "_VAPA(26)
- .W:($P(VAPA(28),"^",2)'="UNITED STATES") !?12,$P(VAPA(28),U,2)
- W ! D KVAR^VADPT Q
- ;
- ;
- LAST4(DFN) ;Return patient "last four"
- N SDX
- S SDX=$G(^DPT(+DFN,0))
- Q $E(SDX)_$E($P(SDX,U,9),6,9)
- ;
- BADADD ;Print patients with a Bad Address Indicator
- I '$D(^TMP($J,"BADADD")) Q
- N SDHDR,SDHDR1
- W @IOF,$TR($J("",IOM)," ","*")
- S SDHDR="BAD ADDRESS INDICATOR LIST" W !,?(IOM-$L(SDHDR)/2),SDHDR,!
- S SDHDR1="** THE LETTER FOR THESE PATIENT(S) DID NOT PRINT DUE TO A BAD ADDRESS INDICATOR."
- W !,"Last 4",!,"of SSN",?10,"Patient Name",!
- W $TR($J("",IOM)," ","*")
- N SDNAM,SDDFN
- S SDNAM="" F S SDNAM=$O(^TMP($J,"BADADD",SDNAM)) Q:SDNAM="" D
- . S SDDFN=0 F S SDDFN=$O(^TMP($J,"BADADD",SDNAM,SDDFN)) Q:'SDDFN D
- . . W !,$$LAST4(SDDFN),?10,SDNAM
- W !!,SDHDR1
- Q
- ;
- TST ; SD*5.3*622 - handle scheduled tests
- W !
- W:($L(SDCL)=3&($E(SDCL,1,3)="LAB")) ?1,SDCL_" SCHEDULED: "_DOW_" "_$J(SDDAT,12)_" "_$J(SDT0,5)
- W:($L(SDCL)=4&($E(SDCL,1,4)="XRAY")) SDCL_" SCHEDULED: "_DOW_" "_$J(SDDAT,12)_" "_$J(SDT0,5)
- W:($L(SDCL)=3&($E(SDCL,1,3)="EKG")) ?1,SDCL_" SCHEDULED: "_DOW_" "_$J(SDDAT,12)_" "_$J(SDT0,5)
- Q ; SD*5.3*622 - end of changes
- ;
- ADLIN() ;
- ; This API is checked to determine if the "ENABLE BLANK LINE?" (#1.1)
- ; field in the SCHEDULING PARAMETERS (404.91) file is set to "YES"
- ; (internal value 1).
- ; Added with patch SD*5.3*705
- N DIQ,DIC,DA,DR
- S DIQ(0)="I",DIC=404.91,DA=1,DR="1.1"
- Q +$$GET1^DIQ(DIC,DA_",",DR,"I")
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDLT 6940 printed Jan 18, 2025@03:59:22 Page 2
- SDLT ;ALB/LDB,GXT - CANCELLATION LETTERS ;17 JUL 2018
- +1 ;;5.3;Scheduling;**185,213,281,330,398,523,441,555,622,641,680,705**;Aug 13, 1993;Build 11
- +2 ;;PER VHA DIRECTIVE 2004-038, DO NOT MODIFY THIS ROUTINE
- +3 ;
- +4 ;**************************************************************************
- +5 ; MODIFICATIONS
- +6 ;
- +7 ; DATE PATCH DEVELOPER DESCRIPTION OF CHANGES
- +8 ; -------- ---------- --------- ----------------------------------------
- +9 ; 02/14/03 SD*5.3*281 SAUNDERS Print letters to confidential address if
- +10 ; requested
- +11 ; 12/2/03 SD*5.3*330 LUNDEN Remove form feed from PRT+0
- +12 ; 01/21/16 SD*5.3*641 HSI Print 1st piece of 99 node
- +13 ; 11/27/17 SD*5.3*680 JACKSON Remove gender implications
- +14 ; 06/13/18 SD*5.3*705 THOMAS Add blank line between appointments in
- +15 ; letters
- +16 ;**************************************************************************
- +17 ;
- +18 NEW Z0,X
- +19 ;WRITE GREETING AND OPENING TEXT OF LETTER
- PRT ;SD*523
- SET DFN=$PIECE(A,U,1)
- +1 ;SD/523
- IF $DATA(SDNOSH)
- IF $DATA(^DPT(DFN,.1))
- SET POP=1
- if POP
- QUIT
- +2 SET Y=DT
- DO DTS^SDUTL
- +3 ;SD*5.3*330 Form feed only after letter #1
- IF +$GET(SDFIRST)=0
- WRITE @IOF
- +4 KILL SDFIRST
- +5 ;S SDFIRST=0
- +6 WRITE !,?65,Y,!,?65,$$LAST4(A),!!!!
- +7 IF 'SDFORM
- WRITE !!!!!
- DO ADDR
- WRITE !!!!
- W1 ;,$S($P(^DPT(+A,0),"^",2)="M":"Mr. ",1:"Ms. ") SD*5.3*680
- WRITE !,"Dear "
- +1 NEW DPTNAME
- +2 SET DPTNAME("FILE")=2
- SET DPTNAME("FIELD")=".01"
- SET DPTNAME("IENS")=(+A)_","
- +3 SET X=$$NAMEFMT^XLFNAME(.DPTNAME,"G","M")
- WRITE X,","
- +4 WRITE !!
- KILL ^UTILITY($JOB,"W"),DIWF,DIWR,DIWF
- SET DIWL=1
- SET DIWF="C80WN"
- FOR Z0=0:0
- SET Z0=$ORDER(^VA(407.5,SDLET,1,Z0))
- if Z0'>0
- QUIT
- SET X=^(Z0,0)
- DO ^DIWP
- +5 DO ^DIWW
- KILL ^UTILITY($JOB,"W")
- QUIT
- WRAPP ;WRITE APPOINTMENT INFORMATION
- +1 NEW B
- +2 ; SD*5.3*622 - re-arrange display of clinic name
- +3 ;S:$D(SC)&'$D(SDC) SDC=SC S SDCL=$P(^SC(+SDC,0),"^",1),SDCL=SDCL_" Clinic" D FORM
- +4 ; SD*5.3*622 end changes
- if $DATA(SC)&'$DATA(SDC)
- SET SDC=SC
- SET SDCL=$PIECE(^SC(+SDC,0),"^",1)
- SET SDCL=" Clinic: "_SDCL
- DO FORM
- +5 ;
- +6 SET SDX1=$SELECT($DATA(SDX):SDX,1:X)
- if $DATA(SDS)
- SET S=SDS
- FOR B=3,4,5
- IF $PIECE(S,"^",B)]""
- SET SDCL=$SELECT(B=3:"LAB",B=4:"XRAY",1:"EKG")
- SET SDX=$PIECE(S,"^",B)
- DO FORM
- +7 SET (SDX,X)=SDX1
- QUIT
- +8 ; SD*5.3*622 - add more detail for appointment and format it
- FORM if $DATA(SDX)
- SET X=SDX
- SET SDHX=X
- DO DW^%DTC
- SET DOW=X
- SET X=SDHX
- XECUTE ^DD("FUNC",2,1)
- SET SDT0=X
- SET SDDAT=$PIECE("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",$EXTRACT(SDHX,4,5))_" "_+$EXTRACT(SDHX,6,7)_", "_(1700+$EXTRACT(SDHX,1,3))
- +1 ; Add blank line between appointments in letters - Done with patch SD*5.3*705
- +2 IF $$ADLIN
- IF '$DATA(B)
- WRITE !
- +3 if '$DATA(B)
- WRITE !?5,"Date/Time: ",?17,DOW,?$LENGTH(DOW)+19,$JUSTIFY(SDDAT,12)
- +4 IF '$DATA(B)
- IF $DATA(SDC)
- WRITE ?22,$JUSTIFY(SDT0,9),!?5,SDCL
- +5 ; get default provider if defined for a given clinic, print it on the
- +6 ; letter only if we have a YES on file, same for clinic location
- +7 ; skip printing the provider label if the field is empty in file #44
- +8 NEW J,SDLOC,SDPROV,SDPRNM,SDTEL,SDTELEXT
- +9 ; physical location of the clinic
- SET SDLOC=$PIECE($GET(^SC(+SDC,0)),"^",11)
- +10 ; telephone number of clinic
- SET SDTEL=$GET(^SC(+SDC,99))
- +11 SET SDTELEXT=""
- IF SDTEL]""
- IF $GET(^SC(+SDC,99.1))]""
- Begin DoDot:1
- +12 ; telephone ext of clinic
- SET SDTELEXT=^SC(+SDC,99.1)
- End DoDot:1
- +13 ; get default provider, if any
- +14 FOR J=0:0
- SET J=$ORDER(^SC(+SDC,"PR",J))
- if 'J>0
- QUIT
- IF $PIECE($GET(^SC(+SDC,"PR",J,0)),U,2)=1
- SET SDPROV=+$PIECE(^SC(+SDC,"PR",J,0),U,1)
- +15 IF $DATA(SDC)
- IF '$DATA(B)
- IF $PIECE($GET(^VA(407.5,SDLET,3)),U,2)="Y"
- Begin DoDot:1
- +16 if SDLOC]""
- WRITE !?6,"Location: "_SDLOC
- End DoDot:1
- +17 IF $DATA(SDC)
- IF '$DATA(B)
- IF SDTEL]""
- Begin DoDot:1
- +18 WRITE !?5,"Telephone: ",$PIECE(SDTEL,U)
- +19 if SDTELEXT]""
- WRITE " Telephone Ext.: ",SDTELEXT
- End DoDot:1
- +20 IF $DATA(SDPROV)
- Begin DoDot:1
- +21 IF $DATA(SDC)
- IF SDPROV>0
- SET SDPRNM=$PIECE(^VA(200,SDPROV,0),U,1)
- +22 IF $DATA(SDC)
- IF '$DATA(B)
- IF $PIECE($GET(^VA(407.5,SDLET,3)),U,1)="Y"
- if SDPRNM]""
- WRITE !?6,"Provider: "_$GET(SDPRNM)
- End DoDot:1
- +23 ; call handler for LAB, XRAY, and EKG tests
- +24 IF $DATA(B)
- DO TST
- +25 IF $DATA(SDLT)&($Y>(IOSL-8))
- WRITE @IOF
- +26 ; SD*5.3*622 end changes
- +27 QUIT
- REST ;WRITE THE REMAINDER OF LETTER
- +1 NEW Z5,I,X
- +2 IF SDLET
- WRITE !?12
- KILL ^UTILITY($JOB,"W"),DIWL,DIWR,DIWF
- SET DIWL=1
- SET DIWF="C80WN"
- FOR Z5=0:0
- SET Z5=$ORDER(^VA(407.5,SDLET,2,Z5))
- if Z5'>0
- QUIT
- SET X=^(Z5,0)
- DO ^DIWP
- +3 DO ^DIWW
- KILL ^UTILITY($JOB,"W")
- if 'SDFORM
- QUIT
- +4 FOR I=$Y:1:IOSL-12
- WRITE !
- +5 DO ADDR
- QUIT
- ADDR KILL VAHOW
- SET DFN=+A
- WRITE !?12,$$FML^DGNFUNC(DFN)
- +1 IF $DATA(^DG(43,1,"BT"))
- IF '$PIECE(^("BT"),"^",3)
- SET VAPA("P")=""
- +2 SET X1=DT
- SET X2=5
- DO C^%DTC
- IF '$DATA(VAPA("P"))
- SET (VATEST("ADD",9),VATEST("ADD",10))=X
- +3 DO ADD^VADPT
- Begin DoDot:1
- +4 ;CHANGE STATE TO ABBR.
- +5 NEW SDIENS,X
- +6 IF $DATA(VAPA(5))
- SET SDIENS=+VAPA(5)_","
- SET X=$$GET1^DIQ(5,SDIENS,1)
- SET $PIECE(VAPA(5),U,2)=X
- +7 IF $DATA(VAPA(17))
- SET SDIENS=+VAPA(17)_","
- SET X=$$GET1^DIQ(5,SDIENS,1)
- SET $PIECE(VAPA(17),U,2)=X
- +8 KILL SDIENS
- QUIT
- End DoDot:1
- +9 NEW SDCCACT1,SDCCACT2,LL
- +10 SET SDCCACT1=VAPA(12)
- SET SDCCACT2=$PIECE($GET(VAPA(22,2)),"^",3)
- +11 ;if confidential address is not active for scheduling/appointment letters, print to regular address
- +12 IF ($GET(SDCCACT1)=0)!($GET(SDCCACT2)'="Y")
- Begin DoDot:1
- +13 FOR LL=1:1:3
- if VAPA(LL)]""
- WRITE !,?12,VAPA(LL)
- +14 ;if country is blank display as USA
- +15 ;display city,state,zip
- IF (VAPA(25)="")!($PIECE(VAPA(25),"^",2)="UNITED STATES")
- Begin DoDot:2
- +16 WRITE !,?12,VAPA(4)_" "_$PIECE(VAPA(5),U,2)_" "_$PIECE(VAPA(11),U,2)
- End DoDot:2
- +17 ;display postal code,city,province
- IF '$TEST
- Begin DoDot:2
- +18 WRITE !,?12,VAPA(24)_" "_VAPA(4)_" "_VAPA(23)
- End DoDot:2
- +19 ;display country
- if ($PIECE(VAPA(25),"^",2)'="UNITED STATES")
- WRITE !,?12,$PIECE(VAPA(25),U,2)
- End DoDot:1
- +20 ;if confidential address is active for scheduling/appointment letters, print to confidential address
- +21 IF $GET(SDCCACT1)=1
- IF $GET(SDCCACT2)="Y"
- Begin DoDot:1
- +22 FOR LL=13:1:15
- if VAPA(LL)]""
- WRITE !,?12,VAPA(LL)
- +23 IF (VAPA(28)="")!($PIECE(VAPA(28),"^",2)="UNITED STATES")
- Begin DoDot:2
- +24 WRITE !,?12,VAPA(16)_" "_$PIECE(VAPA(17),U,2)_" "_$PIECE(VAPA(18),U,2)
- End DoDot:2
- +25 IF '$TEST
- Begin DoDot:2
- +26 WRITE !,?12,VAPA(27)_" "_VAPA(16)_" "_VAPA(26)
- End DoDot:2
- +27 if ($PIECE(VAPA(28),"^",2)'="UNITED STATES")
- WRITE !?12,$PIECE(VAPA(28),U,2)
- End DoDot:1
- +28 WRITE !
- DO KVAR^VADPT
- QUIT
- +29 ;
- +30 ;
- LAST4(DFN) ;Return patient "last four"
- +1 NEW SDX
- +2 SET SDX=$GET(^DPT(+DFN,0))
- +3 QUIT $EXTRACT(SDX)_$EXTRACT($PIECE(SDX,U,9),6,9)
- +4 ;
- BADADD ;Print patients with a Bad Address Indicator
- +1 IF '$DATA(^TMP($JOB,"BADADD"))
- QUIT
- +2 NEW SDHDR,SDHDR1
- +3 WRITE @IOF,$TRANSLATE($JUSTIFY("",IOM)," ","*")
- +4 SET SDHDR="BAD ADDRESS INDICATOR LIST"
- WRITE !,?(IOM-$LENGTH(SDHDR)/2),SDHDR,!
- +5 SET SDHDR1="** THE LETTER FOR THESE PATIENT(S) DID NOT PRINT DUE TO A BAD ADDRESS INDICATOR."
- +6 WRITE !,"Last 4",!,"of SSN",?10,"Patient Name",!
- +7 WRITE $TRANSLATE($JUSTIFY("",IOM)," ","*")
- +8 NEW SDNAM,SDDFN
- +9 SET SDNAM=""
- FOR
- SET SDNAM=$ORDER(^TMP($JOB,"BADADD",SDNAM))
- if SDNAM=""
- QUIT
- Begin DoDot:1
- +10 SET SDDFN=0
- FOR
- SET SDDFN=$ORDER(^TMP($JOB,"BADADD",SDNAM,SDDFN))
- if 'SDDFN
- QUIT
- Begin DoDot:2
- +11 WRITE !,$$LAST4(SDDFN),?10,SDNAM
- End DoDot:2
- End DoDot:1
- +12 WRITE !!,SDHDR1
- +13 QUIT
- +14 ;
- TST ; SD*5.3*622 - handle scheduled tests
- +1 WRITE !
- +2 if ($LENGTH(SDCL)=3&($EXTRACT(SDCL,1,3)="LAB"))
- WRITE ?1,SDCL_" SCHEDULED: "_DOW_" "_$JUSTIFY(SDDAT,12)_" "_$JUSTIFY(SDT0,5)
- +3 if ($LENGTH(SDCL)=4&($EXTRACT(SDCL,1,4)="XRAY"))
- WRITE SDCL_" SCHEDULED: "_DOW_" "_$JUSTIFY(SDDAT,12)_" "_$JUSTIFY(SDT0,5)
- +4 if ($LENGTH(SDCL)=3&($EXTRACT(SDCL,1,3)="EKG"))
- WRITE ?1,SDCL_" SCHEDULED: "_DOW_" "_$JUSTIFY(SDDAT,12)_" "_$JUSTIFY(SDT0,5)
- +5 ; SD*5.3*622 - end of changes
- QUIT
- +6 ;
- ADLIN() ;
- +1 ; This API is checked to determine if the "ENABLE BLANK LINE?" (#1.1)
- +2 ; field in the SCHEDULING PARAMETERS (404.91) file is set to "YES"
- +3 ; (internal value 1).
- +4 ; Added with patch SD*5.3*705
- +5 NEW DIQ,DIC,DA,DR
- +6 SET DIQ(0)="I"
- SET DIC=404.91
- SET DA=1
- SET DR="1.1"
- +7 QUIT +$$GET1^DIQ(DIC,DA_",",DR,"I")