| 1 | SDSCRP ;ALB/JAM - Restricted Stop Code Nonconforming Clinic Report; 07/24/03
|
|---|
| 2 | ;;5.3;Scheduling;**317**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | EN ;foreground entry point
|
|---|
| 5 | N ZTRTN,ZTDESC,ZTIO,ZTQUEUED,SDPCF,DIR,DIRUT,X,Y
|
|---|
| 6 | W @IOF
|
|---|
| 7 | S DIR(0)="SO^A:Active Clinics;I:Inactive Clinics;B:Both"
|
|---|
| 8 | S DIR("A")="Select Report"
|
|---|
| 9 | S DIR("?",1)="Enter an A for Active Clinics, I for Inactive Clinics,"
|
|---|
| 10 | S DIR("?")="B for Both Active and Inactive Clinics"
|
|---|
| 11 | D ^DIR K DIR I $D(DIRUT) G END
|
|---|
| 12 | S SDPCF=Y
|
|---|
| 13 | ;device selection
|
|---|
| 14 | K IOP,%ZIS,POP,IO("Q")
|
|---|
| 15 | S %ZIS("A")="Select Device: ",%ZIS="QM" D ^%ZIS I POP G END
|
|---|
| 16 | I $D(IO("Q")) K IO("Q") D G END
|
|---|
| 17 | .S ZTDESC="Non-Conforming Clinics Stop Code Report",ZTSAVE("SDPCF")=""
|
|---|
| 18 | .S ZTRTN="PROCESS^SDSCRP",ZTIO=ION D ^%ZTLOAD,HOME^%ZIS K ZTSK
|
|---|
| 19 | U IO
|
|---|
| 20 | D PROCESS
|
|---|
| 21 | END D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | PROCESS ;background entry point
|
|---|
| 25 | ;locate invalid Stop Code in HOSPITAL LOCATION file #44
|
|---|
| 26 | N NAM,IDT,RDT,IDAT,STR,ECX,IEN,PSC,SSC,PSCN,SSCN,CNTX,SDPG,SDOUT,SDF,LNS
|
|---|
| 27 | N ACF,SDRDT
|
|---|
| 28 | S %H=$H D YX^%DTC S SDRDT=Y
|
|---|
| 29 | S $P(LNS,"-",80)="",(CNTX,IEN,SDOUT,SDF)=0,SDPG=1
|
|---|
| 30 | D HDR
|
|---|
| 31 | ;search file #44 for invalid entries
|
|---|
| 32 | F S IEN=$O(^SC(IEN)) Q:'IEN D Q:SDOUT S:SDF CNTX=CNTX+1
|
|---|
| 33 | .S ECX=$G(^SC(IEN,0)),PSC=$P(ECX,U,7),SSC=$P(ECX,U,18),SDF=0
|
|---|
| 34 | .I $P(ECX,U,3)'="C" Q
|
|---|
| 35 | .S NAM=$P(ECX,U),IDAT=$G(^SC(IEN,"I")) I IDAT'="" D
|
|---|
| 36 | ..S IDT=$P(IDAT,U),RDT=$P(IDAT,U,2) Q:IDT="" I RDT="" S NAM="*"_NAM Q
|
|---|
| 37 | ..I RDT>IDT S NAM="*"_NAM
|
|---|
| 38 | .S ACF=$S($E(NAM)="*":0,1:1)
|
|---|
| 39 | .I $S((SDPCF="A")&('ACF):1,(SDPCF="I")&(ACF):1,1:0) Q
|
|---|
| 40 | .S PSCN=$S(PSC:$P($G(^DIC(40.7,PSC,0)),U,2),1:"")
|
|---|
| 41 | .S SSCN=$S(SSC:$P($G(^DIC(40.7,SSC,0)),U,2),1:"")
|
|---|
| 42 | .D I SDOUT Q
|
|---|
| 43 | ..I PSC="" S STR="Missing primary code" D PRN Q
|
|---|
| 44 | ..D SCCHK(PSC,"P") I $D(STR) D PRN
|
|---|
| 45 | .I SSC'="" D SCCHK(SSC,"S") I $D(STR) D PRN
|
|---|
| 46 | W !!,?25,$S(CNTX:CNTX,1:"NO")_" PROBLEM CLINICS FOUND."
|
|---|
| 47 | K SCIEN,TYP
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | PRN ;print line
|
|---|
| 51 | I ($Y+3)>IOSL D PAGE,HDR I SDOUT Q
|
|---|
| 52 | W !,IEN,?8,$E(NAM,1,28),?37,PSCN,?46,SSCN,?57,STR
|
|---|
| 53 | S SDF=1
|
|---|
| 54 | Q
|
|---|
| 55 | ;
|
|---|
| 56 | SCCHK(SCIEN,TYP) ;check stop code against file 40.7
|
|---|
| 57 | N SCN,RTY,CTY
|
|---|
| 58 | K STR
|
|---|
| 59 | S CTY=$S(TYP="P":"^P^E^",1:"^S^E^")
|
|---|
| 60 | S SCN=$G(^DIC(40.7,SCIEN,0)),RTY=$P(SCN,U,6),SCN=$P(SCN,U,2)
|
|---|
| 61 | I SCN="" D Q
|
|---|
| 62 | .S STR=SCIEN_" Inv "_$S(TYP="P":"prim",1:"2nd")_" pointr"
|
|---|
| 63 | I RTY="" S STR=SCN_" No restriction type" Q
|
|---|
| 64 | I CTY'[("^"_RTY_"^") D
|
|---|
| 65 | .S STR=SCN_" cannot be "_$S(TYP="P":"prim",1:"second")_"ary"
|
|---|
| 66 | Q
|
|---|
| 67 | ;
|
|---|
| 68 | HDR ;Header for data from file #44
|
|---|
| 69 | W @IOF
|
|---|
| 70 | W SDRDT,?73,"Page: ",SDPG,!
|
|---|
| 71 | W !,?18,"NON-CONFORMING CLINICS STOP CODE REPORT",!,?32
|
|---|
| 72 | W $S(SDPCF="A":"Active",SDPCF="I":"Inactive",1:"All")_" Clinics",!
|
|---|
| 73 | W !,"HOSPITAL LOCATION FILE (#44) - (Use Set up a Clinic [SDBUILD]"
|
|---|
| 74 | W " menu option to",!,?32,"make corrections)"
|
|---|
| 75 | W !!,?37,"PRIMARY",?46,"SECONDARY",?57,"REASON FOR"
|
|---|
| 76 | W !?8,$S(SDPCF="B":"CLINIC NAME",1:""),?37,"STOP",?46,"CREDIT",?57,"NON"
|
|---|
| 77 | W !,"IEN",?8,$S(SDPCF="B":"(*currently inactive)",1:"CLINIC NAME")
|
|---|
| 78 | W ?37,"CODE",?46,"STOP CODE",?57,"CONFORMANCE",!,$E(LNS,1,80)
|
|---|
| 79 | S SDPG=SDPG+1
|
|---|
| 80 | Q
|
|---|
| 81 | ;
|
|---|
| 82 | PAGE ;
|
|---|
| 83 | N SS,JJ,DIR,X,Y
|
|---|
| 84 | I $E(IOST,1,2)="C-" D
|
|---|
| 85 | . S SS=22-$Y F JJ=1:1:SS W !
|
|---|
| 86 | . S DIR(0)="E" W ! D ^DIR K DIR I 'Y S SDOUT=1
|
|---|
| 87 | Q
|
|---|
