SDAMCCKL ;ALB/ART - Clinic Setup Checklist Report ;15 Jul 2014 2:28 PM
;;5.3;Scheduling;**586**;Aug 13, 1993;Build 28
;
; Reference to $$IMP^ICDEX supported by ICR #5747
; Reference to $$CSI^ICDEX supported by ICR #5747
; Reference to $$ICDDX^ICDEX supported by ICR #5747
;
EN ; Main Entry Point
D HOME^%ZIS
S %ZIS="MQ" D ^%ZIS G EXIT:POP
I $D(IO("Q")) K IO("Q") D QUE G EXIT
W ! D WAIT^DICD
D RPT
;
EXIT ;
D:'$D(ZTQUEUED) ^%ZISC
K POP,ZTQUEUED,%ZIS
Q
;
QUE ; Que the report
N ZTDESC,ZTRTN,ZTSK,ZTIO
S ZTRTN="RPT^SDAMCCKL",ZTDESC="Clinic Installation Checklist"
S ZTIO=ION D ^%ZTLOAD
W:$D(ZTSK) !,"TASK #: ",ZTSK
D HOME^%ZIS
K IO("Q")
Q
;
RPT ;Clinic Setup Checklist Report
N SDIEN,SDIENS,SDDXIEN,SDLOC,SDICD,SDCODE,SDDATA,SDDESC,SDDEF,SDVER,SDCRT,SDQUIT
S SDCRT=$S($E(IOST,1,2)="C-":1,1:0)
S SDQUIT=0
U IO
; call header
D HEADER
; loop thru file 44
S SDIEN=0
F S SDIEN=$O(^SC(SDIEN)) Q:'SDIEN D
. ; if location is a clinic
. I $$GET1^DIQ(44,SDIEN,2,"I")="C" D
. . ; Quit if Inactive Clinic
. . N SDACTREC
. . S SDACTREC=$G(^SC(SDIEN,"I"))
. . I +SDACTREC>0 I DT>$P(SDACTREC,U)&($P(SDACTREC,U,2)=""!(DT<$P(SDACTREC,U,2))) Q
. . S SDLOC=$$GET1^DIQ(44,SDIEN,.01) ; clinic name
. . ; loop thru diagnoses
. . S SDDXIEN=0
. . F S SDDXIEN=$O(^SC(SDIEN,"DX",SDDXIEN)) Q:'SDDXIEN!SDQUIT D
. . . I $Y>(IOSL-6) D PAUSE Q:SDQUIT D HEADER
. . . S SDIENS=SDDXIEN_","_SDIEN_","
. . . S SDICD=$$GET1^DIQ(44.11,SDIENS,.01,"I") ; get ICD)
. . . S SDVER=$$CSI^ICDEX(80,SDICD) ; get version
. . . S SDDATA=$$ICDDX^ICDEX(SDICD,$$FMADD^XLFDT($$IMP^ICDEX(30),-1),SDVER,"I")
. . . S SDCODE=$P(SDDATA,U,2) ; get code
. . . S SDDESC=$P(SDDATA,U,4) ; get desc
. . . S SDDEF=$$GET1^DIQ(44.11,SDIENS,.02,"I") ; get default (y or n)
. . . S SDDEF=$S(SDDEF=1:"Y",1:"N")
. . . ; write report line
. . . W !,$E(SDLOC,1,20),?22,SDCODE,?36,$E(SDDESC,1,25),?63,SDDEF
. . . W ?72,"ICD-",$S(SDVER=30:"10",1:"9")
Q
;
;
W @IOF
W !,"Clinic Installation Checklist",?65,$$FMTE^XLFDT($$DT^XLFDT())
W !!,?63,"Default",?72,"Code"
W !,"Clinic",?22,"ICD Code(s)",?36,"Short Description",?63,"(ICD)",?72,"Set"
W !,"--------------------",?22,"------------",?36,"-------------------------"
W ?63,"-------",?72,"------"
Q
;
PAUSE ;- Pause for screen output
Q:'SDCRT
N DIR,DIRUT,DUOUT
I IOSL<30 F W ! Q:$Y>(IOSL-4)
W ! S DIR(0)="E" D ^DIR I $D(DIRUT)!($D(DUOUT)) S SDQUIT=1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAMCCKL 2506 printed Nov 22, 2024@17:57:29 Page 2
SDAMCCKL ;ALB/ART - Clinic Setup Checklist Report ;15 Jul 2014 2:28 PM
+1 ;;5.3;Scheduling;**586**;Aug 13, 1993;Build 28
+2 ;
+3 ; Reference to $$IMP^ICDEX supported by ICR #5747
+4 ; Reference to $$CSI^ICDEX supported by ICR #5747
+5 ; Reference to $$ICDDX^ICDEX supported by ICR #5747
+6 ;
EN ; Main Entry Point
+1 DO HOME^%ZIS
+2 SET %ZIS="MQ"
DO ^%ZIS
if POP
GOTO EXIT
+3 IF $DATA(IO("Q"))
KILL IO("Q")
DO QUE
GOTO EXIT
+4 WRITE !
DO WAIT^DICD
+5 DO RPT
+6 ;
EXIT ;
+1 if '$DATA(ZTQUEUED)
DO ^%ZISC
+2 KILL POP,ZTQUEUED,%ZIS
+3 QUIT
+4 ;
QUE ; Que the report
+1 NEW ZTDESC,ZTRTN,ZTSK,ZTIO
+2 SET ZTRTN="RPT^SDAMCCKL"
SET ZTDESC="Clinic Installation Checklist"
+3 SET ZTIO=ION
DO ^%ZTLOAD
+4 if $DATA(ZTSK)
WRITE !,"TASK #: ",ZTSK
+5 DO HOME^%ZIS
+6 KILL IO("Q")
+7 QUIT
+8 ;
RPT ;Clinic Setup Checklist Report
+1 NEW SDIEN,SDIENS,SDDXIEN,SDLOC,SDICD,SDCODE,SDDATA,SDDESC,SDDEF,SDVER,SDCRT,SDQUIT
+2 SET SDCRT=$SELECT($EXTRACT(IOST,1,2)="C-":1,1:0)
+3 SET SDQUIT=0
+4 USE IO
+5 ; call header
+6 DO HEADER
+7 ; loop thru file 44
+8 SET SDIEN=0
+9 FOR
SET SDIEN=$ORDER(^SC(SDIEN))
if 'SDIEN
QUIT
Begin DoDot:1
+10 ; if location is a clinic
+11 IF $$GET1^DIQ(44,SDIEN,2,"I")="C"
Begin DoDot:2
+12 ; Quit if Inactive Clinic
+13 NEW SDACTREC
+14 SET SDACTREC=$GET(^SC(SDIEN,"I"))
+15 IF +SDACTREC>0
IF DT>$PIECE(SDACTREC,U)&($PIECE(SDACTREC,U,2)=""!(DT<$PIECE(SDACTREC,U,2)))
QUIT
+16 ; clinic name
SET SDLOC=$$GET1^DIQ(44,SDIEN,.01)
+17 ; loop thru diagnoses
+18 SET SDDXIEN=0
+19 FOR
SET SDDXIEN=$ORDER(^SC(SDIEN,"DX",SDDXIEN))
if 'SDDXIEN!SDQUIT
QUIT
Begin DoDot:3
+20 IF $Y>(IOSL-6)
DO PAUSE
if SDQUIT
QUIT
DO HEADER
+21 SET SDIENS=SDDXIEN_","_SDIEN_","
+22 ; get ICD)
SET SDICD=$$GET1^DIQ(44.11,SDIENS,.01,"I")
+23 ; get version
SET SDVER=$$CSI^ICDEX(80,SDICD)
+24 SET SDDATA=$$ICDDX^ICDEX(SDICD,$$FMADD^XLFDT($$IMP^ICDEX(30),-1),SDVER,"I")
+25 ; get code
SET SDCODE=$PIECE(SDDATA,U,2)
+26 ; get desc
SET SDDESC=$PIECE(SDDATA,U,4)
+27 ; get default (y or n)
SET SDDEF=$$GET1^DIQ(44.11,SDIENS,.02,"I")
+28 SET SDDEF=$SELECT(SDDEF=1:"Y",1:"N")
+29 ; write report line
+30 WRITE !,$EXTRACT(SDLOC,1,20),?22,SDCODE,?36,$EXTRACT(SDDESC,1,25),?63,SDDEF
+31 WRITE ?72,"ICD-",$SELECT(SDVER=30:"10",1:"9")
End DoDot:3
End DoDot:2
End DoDot:1
+32 QUIT
+33 ;
+1 ;
+2 WRITE @IOF
+3 WRITE !,"Clinic Installation Checklist",?65,$$FMTE^XLFDT($$DT^XLFDT())
+4 WRITE !!,?63,"Default",?72,"Code"
+5 WRITE !,"Clinic",?22,"ICD Code(s)",?36,"Short Description",?63,"(ICD)",?72,"Set"
+6 WRITE !,"--------------------",?22,"------------",?36,"-------------------------"
+7 WRITE ?63,"-------",?72,"------"
+8 QUIT
+9 ;
PAUSE ;- Pause for screen output
+1 if 'SDCRT
QUIT
+2 NEW DIR,DIRUT,DUOUT
+3 IF IOSL<30
FOR
WRITE !
if $Y>(IOSL-4)
QUIT
+4 WRITE !
SET DIR(0)="E"
DO ^DIR
IF $DATA(DIRUT)!($DATA(DUOUT))
SET SDQUIT=1
+5 QUIT
+6 ;
