| 1 | PRSDFOLL ;HISC/GWB-FOLLOWUP CODE DOWNLOAD PROCESSING ;9-MAR-1998
|
|---|
| 2 | ;;4.0;PAID;**35**;Sep 21, 1995
|
|---|
| 3 | I (DBNAME="MXFLCD-1")!(DBNAME="MXFLYD-1") D INITFU
|
|---|
| 4 | Q:($E(DATA,1,2)=" ")!($E(DATA,1,2)="00")
|
|---|
| 5 | S (FLD,NODE,P)="",F=$E(DATA,1,2),FD=$E(DATA,3,10)
|
|---|
| 6 | I F="DT" S DATA=F,NODE=3,PIECE=17,FLDNUM=115.17 G EXIT
|
|---|
| 7 | I (F="AL")!($E(F)="L")!(F="01")!(F="02")!(F="03")!(F="04")!(F="05")!(F="06")!(F="07")!(F="08")!(F="09")!(F=10)!(F=11)!(F=12)!(F=13)!(F=14) S NODE=2 G NODE
|
|---|
| 8 | I (F=15)!(F=16)!(F=17)!(F=18)!(F=19)!(F=20)!(F=21)!(F=22)!(F=23)!(F=24)!(F=25)!(F=26)!(F=27)!(F=28)!(F=29)!(F=51) S NODE=2 G NODE
|
|---|
| 9 | I (F="AI")!(F="DE")!(F="EM")!(F="FP")!(F="NM")!(F="OG")!(F="OP")!(F="OS")!(F="PM")!(F="PS")!(F="SU")!(F="TS")!(F="UR")!(F="CS")!(F="RR")!($E(F)="S")!(F="DT")!(F=52)!(F="CR")!(F="IM")!(F="MG")!(F="PN")!(F=53) S NODE=3 G NODE
|
|---|
| 10 | I F>29,F<50 S NODE=4
|
|---|
| 11 | NODE I NODE="" Q
|
|---|
| 12 | D:NODE=2 NODE2
|
|---|
| 13 | D:NODE=3 NODE3
|
|---|
| 14 | D:NODE=4 NODE4
|
|---|
| 15 | S PIECE=P,FLDNUM=FLD
|
|---|
| 16 | I $E(F)="L" D
|
|---|
| 17 | . ; compute date for expiration of licensure
|
|---|
| 18 | . S L=$E(F,2),EXYR=$E(FD,1,4),EXMD=$E(FD,5,8)
|
|---|
| 19 | . ; ensure resulting date will be valid if date is a leap day
|
|---|
| 20 | . I EXMD="0229",'$$LEAPYR^PRSLIB00(EXYR+L) S EXMD="0228"
|
|---|
| 21 | . S FD=EXYR+L_EXMD
|
|---|
| 22 | S DATA=FD D DATE^PRSDUTIL
|
|---|
| 23 | S:F="DT" DATA=F
|
|---|
| 24 | EXIT K EXMD,EXYR,F,FD,FLD,L,P Q
|
|---|
| 25 | NODE2 S P=$S(F="AL":1,$E(F)="L":2,F="01":3,F="02":4,F="03":5,F="04":6,F="05":7,F="06":8,F="07":9,F="09":10,F=14:11,F=16:12,F=17:13,F=18:14,F=19:15,F=20:16,F=21:17,F=22:18,F=23:19,F=24:20,F=25:21,F=26:22,F=27:23,F=28:24,F=29:25,F=51:26,1:"")
|
|---|
| 26 | S:P="" P=$S(F="08":27,F=10:28,F=11:29,F=12:30,F=13:31,F=15:32,1:"")
|
|---|
| 27 | S FLD=$S(P=1:89,P=2:90,P=3:91,P=4:92,P=5:93,P=6:94,P=7:95,P=8:96,P=9:97,P=10:98,P=11:99,P=12:100,P=13:101,P=14:102,P=15:103,P=16:104,P=17:105,P=18:106,P=19:107,P=20:108,P=21:109,P=22:110,P=23:111,P=24:112,P=25:113,P=26:114,1:"")
|
|---|
| 28 | S:FLD="" FLD=$S(P=27:97.1,P=28:98.1,P=29:98.2,P=30:98.3,P=31:98.4,P=32:99.1,1:"")
|
|---|
| 29 | Q
|
|---|
| 30 | NODE3 S P=$S(F="AI":1,F="DE":2,F="EM":3,F="FP":4,F="NM":5,F="OG":6,F="OP":7,F="OS":8,F="PM":9,F="PS":10,F="SU":11,F="TS":12,F="UR":13,F="CS":14,F="RR":15,$E(F)="S":16,F="DT":17,F=52:18,F="CR":19,F="IM":20,F="MG":21,F="PN":22,F=53:23,1:PIECE)
|
|---|
| 31 | S FLD=$S(P=1:115.01,P=2:115.02,P=3:115.03,P=4:115.04,P=5:115.05,P=6:115.06,P=7:115.07,P=8:115.08,P=9:115.09,P=10:115.1,P=11:115.11,P=12:115.12,P=13:115.13,P=14:115.14,P=15:115.15,P=16:115.16,P=17:115.17,P=18:114.1,1:"")
|
|---|
| 32 | Q
|
|---|
| 33 | NODE4 S P=$S(F=30:1,F=31:2,F=32:3,F=33:4,F=34:5,F=35:6,F=36:7,F=37:8,F=38:9,F=39:10,F=40:11,F=41:12,F=42:13,F=43:14,F=44:15,F=45:16,F=46:17,F=47:18,F=48:19,F=49:20,1:PIECE)
|
|---|
| 34 | S FLD=$S(P=1:116.01,P=2:116.02,P=3:116.03,P=4:116.04,P=5:116.05,P=6:116.06,P=7:116.07,P=8:116.08,P=9:116.09,P=10:116.1,P=11:116.11,P=12:116.12,P=13:116.13,P=14:116.14,P=15:116.15,P=16:116.16,P=17:116.17,P=18:116.18,P=19:116.19,P=20:116.2,1:"")
|
|---|
| 35 | Q
|
|---|
| 36 | INITFU F FLDNUM=89:1:114,114.1,115.01:.01:115.17,116.01:.01:116.2 I $D(^DD(450,"IX",FLDNUM)) D KILXREF
|
|---|
| 37 | K ^PRSPC(IEN,2),^PRSPC(IEN,3),^PRSPC(IEN,4)
|
|---|
| 38 | K ADD,FLDNUM,FUNODE,FUPIECE,X Q
|
|---|
| 39 | KILXREF S ADD=$P(^DD(450,FLDNUM,0),U,4),FUNODE=$P(ADD,";",1),FUPIECE=$P(ADD,";",2) I $D(^PRSPC(IEN,FUNODE)) S X=$P(^PRSPC(IEN,FUNODE),U,FUPIECE) I X'="" S DA=IEN D KILL^PRSDXREF Q
|
|---|
