- NURAED3 ;HIRMFO/RM,MD,FT-HELP ROUTINE FOR NURSING DATA ;8/9/96 12:33
- ;;4.0;NURSING SERVICE;**32**;Apr 25, 1997
- EN1 ; ENTRY TO GIVE XECUTABLE HELP FOR NAT. CERT FIELD OF 210 FILE
- Q:'$D(^NURSF(210,D0,12,0))!(DA=D0)
- D EN^DDIOL("CURRENT ENTRY IS : ")
- 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("","","!!!")
- Q
- A 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")
- Q
- EN2 ; THIS ENTRY POINT IS UTILIZED BY ALL PRINT ROUTINES WITH SUB-TOTALS
- S (NTOT,NTCT)=0 I NRPT=3 D
- .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
- E D
- .S (V,W,X,Y,Z)=""
- .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
- .Q
- Q
- EN3 ; ENTRY FROM NURS-I-STAFF1 TEMPLATE
- ; THE NURSS, SAVEADD, SAVEADD2, SAVEADD3, SAVEZIP, SAVECITY, SAVESTAT
- ; VARIABLES ARE KILLED OFF IN THE NURS-I-STAFF1 TEMPLATE
- 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))
- 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))
- 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)=""
- K NURSVAR,NURSI,ID
- Q
- EN4 ; VARIABLES N1,NFCNT,NMCNT,NTCT,NTOT ARE KILLED BY CALLING ROUTINE
- S (NX,NTOT)=0 F S NX=$O(^TMP("NURA",$J,NX)) Q:NX="" S NTOT=NTOT+1
- S (NMCNT,NMCNT(1),NFCNT,NFCNT(1),NTCT,NX)=0
- 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
- K NX,NY,NZ Q
- GETNODE ; OBTAIN POINTER TO VA(200
- S ID=$P(^NURSF(210,+NURSDBA,0),"^")
- Q
- EN5 ; POSITION EDIT AS IDENTIFIER FOR STAFF ENTRY
- S NUROUT=0,NURSASS(1)="",NURSPOS(1)="^^^"_NUR200_"^^^^^^^1"
- STDT ; SELECT START DATE
- R !?3,"PRIMARY POSITION START DATE: ",X:DTIME I '$T!(X?1"^".E) S NUROUT=1 G Q5
- I X="" W !?3,$C(7),"Required!!" G STDT
- I X?1"?".E W $C(7),!?3,"Answer with the starting date for the primary position."
- S %DT="E" D ^%DT I +Y'>0 W:X'?1"?".E $C(7)," ??" G STDT
- S $P(NURSPOS(1),"^",3)=+Y
- LOCN ; SELECT LOCATION
- R !?3,"PRIMARY DUTY LOCATION: ",X:DTIME I '$T!(X?1"^".E) S NUROUT=1 G Q5
- I X="" W !?3,$C(7),"Required!!" G LOCN
- S DIC=211.4,DIC(0)="QMEZ" D ^DIC K DIC I +Y'>0 G LOCN
- S $P(NURSPOS(1),"^")=$P(Y,"^",2)
- SPON ; SELECT SERVICE POSITION
- R !?3,"PRIMARY SERVICE POSITION: ",X:DTIME I '$T!(X?1"^".E) S NUROUT=1 G Q5
- I X="" W !?3,$C(7),"Required!!" G STDT
- S DIC=211.3,DIC(0)="QMEZ" D ^DIC K DIC I +Y'>0 G SPON
- S $P(NURSPOS(1),"^",2)=$P(Y(0),"^",5),$P(NURSPOS(1),"^",5)=+Y
- Q5 ;
- I '$G(NUROUT) D EN2^NURAED6
- I $G(NUROUT) W !?3,$C(7),"No position data stored!!"
- K %DT,DIC,NUROUT,NURSASS,NURSPOS
- Q
- EN6 ;XECUTABLE HELP FOR EXPERIENCE FIELD OF 210 FILE
- S NURSLO=$S($D(^NURSF(210,D0,20,+Y,0)):^(0),1:"") D DICW
- K NURSLO D EN^DDIOL($E(@(DIC_Y_",0)"),0),"","?0")
- Q
- DICW ; EXECTUTED BY DIC("W") STRING IN PROFESSIONAL EXPERIENCE LOOKUP FROM
- ; PROFESSIONAL EXPERIENCE [NURAED-STF-EXP] OPTION.
- I $P(NURSLO,U)'="" D
- . S NURSLO(1)=$P(NURSLO,U),NURSLO(1,"F")="?5"
- . S NURSLO(2)=$P(NURSLO,U,4),NURSLO(2,"F")="?32"
- . Q
- I +$E($P(NURSLO,U,5),1,3)>0 D
- . S NURSLO(3)=$E($P(NURSLO,U,5),2,3),NURSLO(3,"F")="?63"
- . Q
- I +$E($P(NURSLO,U,6),1,3)>0 D
- . S NURSLO(4)=" to "_$E($P(NURSLO,U,6),2,3),NURSLO(4,"F")="?65"
- . Q
- S NURSLO(5)="",NURSLO(5,"F")="!"
- D:$G(NURSLO(1))'="" EN^DDIOL(.NURSLO)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURAED3 4139 printed Jan 18, 2025@03:20:25 Page 2
- NURAED3 ;HIRMFO/RM,MD,FT-HELP ROUTINE FOR NURSING DATA ;8/9/96 12:33
- +1 ;;4.0;NURSING SERVICE;**32**;Apr 25, 1997
- EN1 ; ENTRY TO GIVE XECUTABLE HELP FOR NAT. CERT FIELD OF 210 FILE
- +1 if '$DATA(^NURSF(210,D0,12,0))!(DA=D0)
- QUIT
- +2 DO EN^DDIOL("CURRENT ENTRY IS : ")
- +3 IF $DATA(^NURSF(210,D0,12,DA,0))
- IF $PIECE(^(0),U)'=""
- IF $DATA(^NURSF(212.2,$PIECE(^NURSF(210,D0,12,DA,0),U),0))
- SET Z=DA
- DO A
- DO EN^DDIOL("","","!!!")
- +4 QUIT
- A IF $DATA(^NURSF(210,D0,12,Z,0))
- IF $PIECE(^(0),U)'=""
- IF $DATA(^NURSF(212.2,$PIECE(^NURSF(210,D0,12,Z,0),U),0))
- DO EN^DDIOL(Z_" "_$PIECE(^(0),"^")_" "_$PIECE(^(0),"^",2)_" "_$PIECE(^(0),"^",3),"","!?3")
- +1 QUIT
- EN2 ; THIS ENTRY POINT IS UTILIZED BY ALL PRINT ROUTINES WITH SUB-TOTALS
- +1 SET (NTOT,NTCT)=0
- IF NRPT=3
- Begin DoDot:1
- +2 SET X=0
- FOR
- SET X=$ORDER(^TMP("NURA",$JOB,X))
- if X'>0
- QUIT
- SET NTOT=NTOT+1
- SET Y=0
- FOR
- SET Y=$ORDER(^TMP("NURA",$JOB,X,Y))
- if Y'>0
- QUIT
- SET NTCT=NTCT+1
- End DoDot:1
- +3 IF '$TEST
- Begin DoDot:1
- +4 SET (V,W,X,Y,Z)=""
- +5 FOR
- SET V=$ORDER(^TMP("NURA",$JOB,V))
- if V=""
- QUIT
- FOR
- SET W=$ORDER(^TMP("NURA",$JOB,V,W))
- if W=""
- QUIT
- FOR
- SET X=$ORDER(^TMP("NURA",$JOB,V,W,X))
- if X'>0
- QUIT
- SET NTOT=NTOT+1
- FOR
- SET Y=$ORDER(^TMP("NURA",$JOB,V,W,X,Y))
- if Y'>0
- QUIT
- FOR
- SET Z=$ORDER(^TMP("NURA",$JOB,V,W,X,Y,Z))
- if Z'>0
- QUIT
- SET NTCT=NTCT+1
- +6 QUIT
- End DoDot:1
- +7 QUIT
- EN3 ; ENTRY FROM NURS-I-STAFF1 TEMPLATE
- +1 ; THE NURSS, SAVEADD, SAVEADD2, SAVEADD3, SAVEZIP, SAVECITY, SAVESTAT
- +2 ; VARIABLES ARE KILLED OFF IN THE NURS-I-STAFF1 TEMPLATE
- +3 DO GETNODE
- SET NURSS=$SELECT('$DATA(^VA(200,ID,.11)):0,1:1)
- SET SAVEADD=$SELECT('NURSS:"",1:$PIECE(^(.11),"^",1))
- SET SAVEADD2=$SELECT('NURSS:"",1:$PIECE(^(.11),"^",2))
- SET SAVEADD3=$SELECT('NURSS:"",1:$PIECE(^(.11),"^",3))
- SET SAVEZIP=$SELECT('NURSS:"",1:$PIECE(^(.11),"^",6))
- +4 SET SAVECITY=$SELECT('NURSS:"",1:$PIECE(^VA(200,ID,.11),"^",4))
- SET SAVESTAT=$SELECT('NURSS:"",$PIECE(^VA(200,ID,.11),"^",5)="":"",'$DATA(^DIC(5,$PIECE(^VA(200,ID,.11),"^",5),0)):"",1:$PIECE(^(0),"^",1))
- +5 FOR NURSI=1:1:6
- SET NURSVAR=$SELECT(NURSI=1:"SAVEADD",NURSI=2:"SAVEADD2",NURSI=3:"SAVEADD3",NURSI=4:"SAVECITY",NURSI=5:"SAVESTAT",1:"SAVEZIP")
- IF @NURSVAR=""
- SET $PIECE(^NURSF(210,DA,15),"^",NURSI)=""
- +6 KILL NURSVAR,NURSI,ID
- +7 QUIT
- EN4 ; VARIABLES N1,NFCNT,NMCNT,NTCT,NTOT ARE KILLED BY CALLING ROUTINE
- +1 SET (NX,NTOT)=0
- FOR
- SET NX=$ORDER(^TMP("NURA",$JOB,NX))
- if NX=""
- QUIT
- SET NTOT=NTOT+1
- +2 SET (NMCNT,NMCNT(1),NFCNT,NFCNT(1),NTCT,NX)=0
- +3 FOR
- SET NX=$ORDER(^TMP("NURA",$JOB,NX))
- if NX=""
- QUIT
- SET NY=""
- FOR
- SET NY=$ORDER(^TMP("NURA",$JOB,NX,NY))
- if NY=""
- QUIT
- if NY="M"
- SET NMCNT=NMCNT+1
- SET NMCNT(1)=NMCNT(1)+1
- if NY="F"
- SET NFCNT=NFCNT+1
- SET NFCNT(1)=NFCNT(1)+1
- SET NZ=0
- FOR
- SET NZ=$ORDER(^TMP("NURA",$JOB,NX,NY,NZ))
- if NZ'>0
- QUIT
- SET NTCT=NTCT+1
- +4 KILL NX,NY,NZ
- QUIT
- GETNODE ; OBTAIN POINTER TO VA(200
- +1 SET ID=$PIECE(^NURSF(210,+NURSDBA,0),"^")
- +2 QUIT
- EN5 ; POSITION EDIT AS IDENTIFIER FOR STAFF ENTRY
- +1 SET NUROUT=0
- SET NURSASS(1)=""
- SET NURSPOS(1)="^^^"_NUR200_"^^^^^^^1"
- STDT ; SELECT START DATE
- +1 READ !?3,"PRIMARY POSITION START DATE: ",X:DTIME
- IF '$TEST!(X?1"^".E)
- SET NUROUT=1
- GOTO Q5
- +2 IF X=""
- WRITE !?3,$CHAR(7),"Required!!"
- GOTO STDT
- +3 IF X?1"?".E
- WRITE $CHAR(7),!?3,"Answer with the starting date for the primary position."
- +4 SET %DT="E"
- DO ^%DT
- IF +Y'>0
- if X'?1"?".E
- WRITE $CHAR(7)," ??"
- GOTO STDT
- +5 SET $PIECE(NURSPOS(1),"^",3)=+Y
- LOCN ; SELECT LOCATION
- +1 READ !?3,"PRIMARY DUTY LOCATION: ",X:DTIME
- IF '$TEST!(X?1"^".E)
- SET NUROUT=1
- GOTO Q5
- +2 IF X=""
- WRITE !?3,$CHAR(7),"Required!!"
- GOTO LOCN
- +3 SET DIC=211.4
- SET DIC(0)="QMEZ"
- DO ^DIC
- KILL DIC
- IF +Y'>0
- GOTO LOCN
- +4 SET $PIECE(NURSPOS(1),"^")=$PIECE(Y,"^",2)
- SPON ; SELECT SERVICE POSITION
- +1 READ !?3,"PRIMARY SERVICE POSITION: ",X:DTIME
- IF '$TEST!(X?1"^".E)
- SET NUROUT=1
- GOTO Q5
- +2 IF X=""
- WRITE !?3,$CHAR(7),"Required!!"
- GOTO STDT
- +3 SET DIC=211.3
- SET DIC(0)="QMEZ"
- DO ^DIC
- KILL DIC
- IF +Y'>0
- GOTO SPON
- +4 SET $PIECE(NURSPOS(1),"^",2)=$PIECE(Y(0),"^",5)
- SET $PIECE(NURSPOS(1),"^",5)=+Y
- Q5 ;
- +1 IF '$GET(NUROUT)
- DO EN2^NURAED6
- +2 IF $GET(NUROUT)
- WRITE !?3,$CHAR(7),"No position data stored!!"
- +3 KILL %DT,DIC,NUROUT,NURSASS,NURSPOS
- +4 QUIT
- EN6 ;XECUTABLE HELP FOR EXPERIENCE FIELD OF 210 FILE
- +1 SET NURSLO=$SELECT($DATA(^NURSF(210,D0,20,+Y,0)):^(0),1:"")
- DO DICW
- +2 KILL NURSLO
- DO EN^DDIOL($EXTRACT(@(DIC_Y_",0)"),0),"","?0")
- +3 QUIT
- DICW ; EXECTUTED BY DIC("W") STRING IN PROFESSIONAL EXPERIENCE LOOKUP FROM
- +1 ; PROFESSIONAL EXPERIENCE [NURAED-STF-EXP] OPTION.
- +2 IF $PIECE(NURSLO,U)'=""
- Begin DoDot:1
- +3 SET NURSLO(1)=$PIECE(NURSLO,U)
- SET NURSLO(1,"F")="?5"
- +4 SET NURSLO(2)=$PIECE(NURSLO,U,4)
- SET NURSLO(2,"F")="?32"
- +5 QUIT
- End DoDot:1
- +6 IF +$EXTRACT($PIECE(NURSLO,U,5),1,3)>0
- Begin DoDot:1
- +7 SET NURSLO(3)=$EXTRACT($PIECE(NURSLO,U,5),2,3)
- SET NURSLO(3,"F")="?63"
- +8 QUIT
- End DoDot:1
- +9 IF +$EXTRACT($PIECE(NURSLO,U,6),1,3)>0
- Begin DoDot:1
- +10 SET NURSLO(4)=" to "_$EXTRACT($PIECE(NURSLO,U,6),2,3)
- SET NURSLO(4,"F")="?65"
- +11 QUIT
- End DoDot:1
- +12 SET NURSLO(5)=""
- SET NURSLO(5,"F")="!"
- +13 if $GET(NURSLO(1))'=""
- DO EN^DDIOL(.NURSLO)
- +14 QUIT