source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURAED3.m@ 623

Last change on this file since 623 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1NURAED3 ;HIRMFO/RM,MD,FT-HELP ROUTINE FOR NURSING DATA ;8/9/96 12:33
2 ;;4.0;NURSING SERVICE;**32**;Apr 25, 1997
3EN1 ; ENTRY TO GIVE XECUTABLE HELP FOR NAT. CERT FIELD OF 210 FILE
4 Q:'$D(^NURSF(210,D0,12,0))!(DA=D0)
5 D EN^DDIOL("CURRENT ENTRY IS : ")
6 I $D(^NURSF(210,D0,12,DA,0)),$P(^(0),U)'="",$D(^NURSF(212.2,$P(^NURSF(210,D0,12,DA,0),U),0)) S Z=DA D A,EN^DDIOL("","","!!!")
7 Q
8A I $D(^NURSF(210,D0,12,Z,0)),$P(^(0),U)'="",$D(^NURSF(212.2,$P(^NURSF(210,D0,12,Z,0),U),0)) D EN^DDIOL(Z_" "_$P(^(0),"^")_" "_$P(^(0),"^",2)_" "_$P(^(0),"^",3),"","!?3")
9 Q
10EN2 ; THIS ENTRY POINT IS UTILIZED BY ALL PRINT ROUTINES WITH SUB-TOTALS
11 S (NTOT,NTCT)=0 I NRPT=3 D
12 .S X=0 F S X=$O(^TMP("NURA",$J,X)) Q:X'>0 S NTOT=NTOT+1 S Y=0 F S Y=$O(^TMP("NURA",$J,X,Y)) Q:Y'>0 S NTCT=NTCT+1
13 E D
14 .S (V,W,X,Y,Z)=""
15 .F S V=$O(^TMP("NURA",$J,V)) Q:V="" F S W=$O(^TMP("NURA",$J,V,W)) Q:W="" F S X=$O(^TMP("NURA",$J,V,W,X)) Q:X'>0 S NTOT=NTOT+1 F S Y=$O(^TMP("NURA",$J,V,W,X,Y)) Q:Y'>0 F S Z=$O(^TMP("NURA",$J,V,W,X,Y,Z)) Q:Z'>0 S NTCT=NTCT+1
16 .Q
17 Q
18EN3 ; ENTRY FROM NURS-I-STAFF1 TEMPLATE
19 ; THE NURSS, SAVEADD, SAVEADD2, SAVEADD3, SAVEZIP, SAVECITY, SAVESTAT
20 ; VARIABLES ARE KILLED OFF IN THE NURS-I-STAFF1 TEMPLATE
21 D GETNODE S NURSS=$S('$D(^VA(200,ID,.11)):0,1:1),SAVEADD=$S('NURSS:"",1:$P(^(.11),"^",1)),SAVEADD2=$S('NURSS:"",1:$P(^(.11),"^",2)),SAVEADD3=$S('NURSS:"",1:$P(^(.11),"^",3)),SAVEZIP=$S('NURSS:"",1:$P(^(.11),"^",6))
22 S SAVECITY=$S('NURSS:"",1:$P(^VA(200,ID,.11),"^",4)),SAVESTAT=$S('NURSS:"",$P(^VA(200,ID,.11),"^",5)="":"",'$D(^DIC(5,$P(^VA(200,ID,.11),"^",5),0)):"",1:$P(^(0),"^",1))
23 F NURSI=1:1:6 S NURSVAR=$S(NURSI=1:"SAVEADD",NURSI=2:"SAVEADD2",NURSI=3:"SAVEADD3",NURSI=4:"SAVECITY",NURSI=5:"SAVESTAT",1:"SAVEZIP") I @NURSVAR="" S $P(^NURSF(210,DA,15),"^",NURSI)=""
24 K NURSVAR,NURSI,ID
25 Q
26EN4 ; VARIABLES N1,NFCNT,NMCNT,NTCT,NTOT ARE KILLED BY CALLING ROUTINE
27 S (NX,NTOT)=0 F S NX=$O(^TMP("NURA",$J,NX)) Q:NX="" S NTOT=NTOT+1
28 S (NMCNT,NMCNT(1),NFCNT,NFCNT(1),NTCT,NX)=0
29 F S NX=$O(^TMP("NURA",$J,NX)) Q:NX="" S NY="" F S NY=$O(^TMP("NURA",$J,NX,NY)) Q:NY="" S:NY="M" NMCNT=NMCNT+1,NMCNT(1)=NMCNT(1)+1 S:NY="F" NFCNT=NFCNT+1,NFCNT(1)=NFCNT(1)+1 S NZ=0 F S NZ=$O(^TMP("NURA",$J,NX,NY,NZ)) Q:NZ'>0 S NTCT=NTCT+1
30 K NX,NY,NZ Q
31GETNODE ; OBTAIN POINTER TO VA(200
32 S ID=$P(^NURSF(210,+NURSDBA,0),"^")
33 Q
34EN5 ; POSITION EDIT AS IDENTIFIER FOR STAFF ENTRY
35 S NUROUT=0,NURSASS(1)="",NURSPOS(1)="^^^"_NUR200_"^^^^^^^1"
36STDT ; SELECT START DATE
37 R !?3,"PRIMARY POSITION START DATE: ",X:DTIME I '$T!(X?1"^".E) S NUROUT=1 G Q5
38 I X="" W !?3,$C(7),"Required!!" G STDT
39 I X?1"?".E W $C(7),!?3,"Answer with the starting date for the primary position."
40 S %DT="E" D ^%DT I +Y'>0 W:X'?1"?".E $C(7)," ??" G STDT
41 S $P(NURSPOS(1),"^",3)=+Y
42LOCN ; SELECT LOCATION
43 R !?3,"PRIMARY DUTY LOCATION: ",X:DTIME I '$T!(X?1"^".E) S NUROUT=1 G Q5
44 I X="" W !?3,$C(7),"Required!!" G LOCN
45 S DIC=211.4,DIC(0)="QMEZ" D ^DIC K DIC I +Y'>0 G LOCN
46 S $P(NURSPOS(1),"^")=$P(Y,"^",2)
47SPON ; SELECT SERVICE POSITION
48 R !?3,"PRIMARY SERVICE POSITION: ",X:DTIME I '$T!(X?1"^".E) S NUROUT=1 G Q5
49 I X="" W !?3,$C(7),"Required!!" G STDT
50 S DIC=211.3,DIC(0)="QMEZ" D ^DIC K DIC I +Y'>0 G SPON
51 S $P(NURSPOS(1),"^",2)=$P(Y(0),"^",5),$P(NURSPOS(1),"^",5)=+Y
52Q5 ;
53 I '$G(NUROUT) D EN2^NURAED6
54 I $G(NUROUT) W !?3,$C(7),"No position data stored!!"
55 K %DT,DIC,NUROUT,NURSASS,NURSPOS
56 Q
57EN6 ;XECUTABLE HELP FOR EXPERIENCE FIELD OF 210 FILE
58 S NURSLO=$S($D(^NURSF(210,D0,20,+Y,0)):^(0),1:"") D DICW
59 K NURSLO D EN^DDIOL($E(@(DIC_Y_",0)"),0),"","?0")
60 Q
61DICW ; EXECTUTED BY DIC("W") STRING IN PROFESSIONAL EXPERIENCE LOOKUP FROM
62 ; PROFESSIONAL EXPERIENCE [NURAED-STF-EXP] OPTION.
63 I $P(NURSLO,U)'="" D
64 . S NURSLO(1)=$P(NURSLO,U),NURSLO(1,"F")="?5"
65 . S NURSLO(2)=$P(NURSLO,U,4),NURSLO(2,"F")="?32"
66 . Q
67 I +$E($P(NURSLO,U,5),1,3)>0 D
68 . S NURSLO(3)=$E($P(NURSLO,U,5),2,3),NURSLO(3,"F")="?63"
69 . Q
70 I +$E($P(NURSLO,U,6),1,3)>0 D
71 . S NURSLO(4)=" to "_$E($P(NURSLO,U,6),2,3),NURSLO(4,"F")="?65"
72 . Q
73 S NURSLO(5)="",NURSLO(5,"F")="!"
74 D:$G(NURSLO(1))'="" EN^DDIOL(.NURSLO)
75 Q
Note: See TracBrowser for help on using the repository browser.