| [613] | 1 | DVBHQAT ;ISC-ALbany/JLU HINQ packing routine [ 09/21/94 1:23 PM ]
|
|---|
| 2 | ;;4.0;HINQ;**22,32,36,49**;03/25/92
|
|---|
| 3 | ;
|
|---|
| 4 | KIL K J,LF,D,K,N,T,Y0,Z1,LP,L2,L3,DVBLEN,DVBIO,DVBNUM,F1,F2,X1,G,I,T1,DVBTIME,Z,L,DVBDEV,DVBDSCH,DVBECHO,DVBEND,DVBLOG,DVBPRGM,DVBTIM,DVBTMX,DVBXM,DVBZ,DVBABORT,DVBVDI,DVBTSK,DVBCN,DVBP,DVBSN,DFN,DIC,X,Y,R,DVBDXSC,DVBIXMZ,DVBUSER,DVBCS
|
|---|
| 5 | K DVBI,DVBFUE,DVBFUF,DVBBAS,DVBBIR,DVBINC,DVBP,DVBV1
|
|---|
| 6 | K DVBID,DVBIDCU,DVBPU,DVBPW,DVBS,DVBV2,LP2,LX,LY,NXL,SPN
|
|---|
| 7 | K DVBTRY,DVBRTC,DVBNRT
|
|---|
| 8 | Q
|
|---|
| 9 | ;
|
|---|
| 10 | HP W !!," Input from the 'P'atient File only requires you to select a Patient Name.",!," 'D'irect input will prompt for Social Security Number, Claim Number or Service Number.",!," You may enter Patients not in the Patient file."
|
|---|
| 11 | W !," Direct input will not enter Patients in the Patient File."
|
|---|
| 12 | Q
|
|---|
| 13 | ;
|
|---|
| 14 | E S DVB12=1
|
|---|
| 15 | F A=0:0 S A=$O(X(A)) Q:'A D S
|
|---|
| 16 | K X
|
|---|
| 17 | Q:'$D(XY(1))
|
|---|
| 18 | F A=0:0 S A=$O(XY(A)) Q:'A S X(A)=XY(A) K XY(A)
|
|---|
| 19 | ;
|
|---|
| 20 | EX K DVB12,A,XY,B,L
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | S I $L(X(A))=245 S XY(DVB12)=X(A),DVB12=DVB12+1 K X(A) Q
|
|---|
| 24 | I $L(X(A))<245 D S1 Q
|
|---|
| 25 | I $L(X(A))>245 D S2 Q
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | S1 S XY(DVB12)=X(A) K X(A) F B=0:0 S B=$O(X(B)) Q:'B S L=245-$L(XY(DVB12)),XY(DVB12)=XY(DVB12)_$E(X(B),1,L),X(B)=$E(X(B),L+1,999) K:'$L(X(B)) X(B) I $L(XY(DVB12))=245 S DVB12=DVB12+1 Q
|
|---|
| 29 | Q
|
|---|
| 30 | ;
|
|---|
| 31 | S2 F B=0:0 S XY(DVB12)=$E(X(A),1,245),X(A)=$E(X(A),246,999),DVB12=DVB12+1 I $L(X(A))<245 S A=0 Q
|
|---|
| 32 | Q
|
|---|
| 33 | ;
|
|---|
| 34 | CNLKUP S CN=$S($D(^DPT(DFN,.31)):$P(^(.31),"^",3),1:"")
|
|---|
| 35 | I 'CN Q
|
|---|
| 36 | I CN["P" S CN="" Q
|
|---|
| 37 | S CN=$E(" 00000000",1,9-$L(CN))_CN
|
|---|
| 38 | S DVBZ=$E(DVBZ,1,$L(DVBZ)-8)_"CN"_CN_$E(DVBZ,$L(DVBZ)-7,99)
|
|---|
| 39 | S CN=$F(DVBZ,"/CN",24) Q
|
|---|
| 40 | ;
|
|---|
| 41 | STUFF Q:'DFN
|
|---|
| 42 | S DVBNOWRT="",DVBZSAV=DVBZ,DVBZ=$E(DVBZ,1,$L(DVBZ)-4)
|
|---|
| 43 | D DIV^DVBHQZ4,EN1^DVBHQUT
|
|---|
| 44 | S DVBZ=DVBZSAV K DVBZSAV Q
|
|---|
